c -h- acini1.fnw	Fri Aug 22 12:55:08 1986	
C PORTACALC MAIN PROGRAM
C SPREAD SHEET DRIVER PROGRAM
C COPYRIGHT (C) 1983,1984 GLENN AND MARY EVERHART
C ALL RIGHTS RESERVED
C MAX SHEET DIMS ARE 60 BY 300 (301 SINCE ACCUMULATORS ARE A PSEUDO ROW)
C NOTE: THROUGHOUT, ROWS ARE ACTUALLY DOWN, COLUMNS ACROSS ON
C SCREEN.
	SUBROUTINE INITA1(KMAP,KWID,ICODE)
C
	InTeGer*4 PRL(6)
        CHARACTER*1 NOWRAP ( 2 )
	CHARACTER*1 FORM,FVLD,CMDLIN(132)
	INTEGER*4 VNLT
	INTEGER IFCW
c	EXTERNAL LCWRQQ
	DIMENSION FORM(128),FVLD(1,1)
C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE
C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S
C SO INITIALLY IGNORE.
C ***<<<< RDD COMMON START >>>***
	InTeGer*4 RRWACT,RCLACT
C	COMMON/RCLACT/RRWACT,RCLACT
	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8
C	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
C     1  IDOL7,IDOL8
	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
C	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
C	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	InTeGer*4 KLVL
C	COMMON/KLVL/KLVL
	InTeGer*4 IOLVL,IGOLD
C	COMMON/IOLVL/IOLVL
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
     2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
C ***<<< RDD COMMON END >>>***
CCC	InTeGer*4 RRWACT,RCLACT
CCC	COMMON/RCLACT/RRWACT,RCLACT
CCC	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
CCC     1  IDOL7,IDOL8
CCC	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
CCC     1  IDOL7,IDOL8
CCC	InTeGer*4 LLCMD,LLDSP
CCC	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
CCC	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
	DIMENSION NRDSP(20,75),NCDSP(20,75)
	COMMON/D2R/NRDSP,NCDSP
CCC	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
CCC	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	CHARACTER*1 FORM2(4)
C ***<<< XVXTCD COMMON START >>>***
	CHARACTER*1 OARRY(100)
	InTeGer*4 OSWIT,OCNTR
C	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTeGer*4 IPS1,IPS2,MODFLG
C	COMMON/ICPOS/IPS1,IPS2,MODFLG
   	InTeGer*4 XTCFG,IPSET,XTNCNT
   	CHARACTER*1 XTNCMD(80)
C   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
	INTEGER KALKIT
C	COMMON/VARYIT/KALKIT
	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
	InTeGer*4 RCMODE,IRCE1,IRCE2
C	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
C     1  IRCE2
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
C RCFGX ON.
C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
C  AND VM INHIBITS. (SETS TO 1).
	INTEGER*4 FH
C FILE HANDLE FOR CONSOLE I/O (RAW)
C	COMMON/CONSFH/FH
	CHARACTER*1 ARGSTR(52,4)
C	COMMON/ARGSTR/ARGSTR
	COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IPS1,IPS2,MODFLG,
     1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
     2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
     3  IRCE2,FH,ARGSTR
C ***<<< XVXTCD COMMON END >>>***
CCC	InTeGer*4 OSWIT,OCNTR
CCC	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTeGer*4 TYPE(1,1),VLEN(9)
CCC	InTeGer*4 KLVL
CCC	COMMON/KLVL/KLVL
CCC	InTeGer*4 IOLVL
CCC	COMMON/IOLVL/IOLVL
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	CHARACTER*1 AVBLS(20,27),VBLS(8,1,1)
	REAL*8 XXV(1,1)
	EQUIVALENCE(XXV(1,1),VBLS(1,1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
C DEFFMT IS THE DEFAULT FORMAT FOR NUMERICS. INITIALLY IT WILL BE F9.2
	CHARACTER*1 DVFMT(12),DEFFMT(10)
	CHARACTER*12 CDVFMT
	EQUIVALENCE(DVFMT(2),DEFFMT(1))
	EQUIVALENCE(CDVFMT(1:1),DVFMT(1))
	COMMON/DEFVBX/DVFMT
	CHARACTER*1 NMSH(80)
	CHARACTER*80 NMSH80
	EQUIVALENCE(NMSH80(1:1),NMSH(1))
	COMMON/NMSH/NMSH
CCC	InTeGer*4 IPS1,IPS2,MODFLG
CCC	COMMON/ICPOS/IPS1,IPS2,MODFLG
CCC   	InTeGer*4 XTCFG,IPSET,XTNCNT
CCC   	CHARACTER*1 XTNCMD(80)
CCC   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
CCC	INTEGER KALKIT
CCC	COMMON/VARYIT/KALKIT
CCC	InTeGer*4 FORMFG,RCFGX,PZAP
CCC	InTeGer*4 RCONE,RCMODE,IRCE1,IRCE2
CCC	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,
CCC     1  IRCE1,IRCE2
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALC
C DISPLAY ARRAY WILL KEEP A COPY OF VARIABLES DISPLAYED
	InTeGer*4 CWIDS(20)
C CWIDS IS WIDTHS IN CHARACTERS OF COLUMNS ON DISPLAY.
	INTEGER*4 I4TMP
C ***<<< NULETC COMMON START >>>***
	InTeGer*4 ICREF,IRREF
C	COMMON/MIRROR/ICREF,IRREF
	InTeGer*4 MODPUB,LIMODE
C	COMMON/MODPUB/MODPUB,LIMODE
	InTeGer*4 KLKC,KLKR
	REAL*8 AACP,AACQ
C	COMMON/MSCMN/KLKC,KLKR,AACP,AACQ
	InTeGer*4 NCEL,NXINI
C	COMMON/NCEL/NCEL,NXINI
	CHARACTER*1 NAMARY(20,301)
C	COMMON/NMNMNM/NAMARY
	InTeGer*4 NULAST,LFVD
C	COMMON/NULXXX/NULAST,LFVD
	COMMON/NULETC/ICREF,IRREF,MODPUB,LIMODE,
     1  KLKC,KLKR,AACP,AACQ,NCEL,NXINI,NAMARY,NULAST,LFVD
C ***<<< NULETC COMMON END >>>***
CCC	InTeGer*4 ICREF,IRREF
CCC	COMMON/MIRROR/ICREF,IRREF
C SETS NUMBER OF COLS TO ADD ON ROW OVERFLOW, ROWS TO ADD ON COL OVERFLOW
C FOR CELL ALIASING.
	REAL*8 DVS(20,75)
	COMMON /FVLDC/FVLD
C FOLLOWING SUPPORT VVARY OVERLAY:
	REAL*8 QQAC(26),QDERIV(8),QDEL(8),OLDVV,OLDX,OLDA
	LOGICAL*4 LEXIST
	InTeGer*4 QCAC,QCENT(8),ACV(8)
	COMMON/VRYDAT/QQAC,QDERIV,QDEL,QCAC,QCENT,OLDVV,OLDX,OLDA,ACV
	COMMON/DSPCMN/DVS,CWIDS
	CHARACTER*1 CHR
	character*20 fwt
	EQUIVALENCE(FWT(1:1),CHR)
C DISABLE FLOATING EXCEPTIONS
C	CALL LCWRQQ(IFCW)
C (MOVED LCWRQQ CALL TO MAIN)
	IDOL7=1
C ENABLE SCROLLING INITIALLY
C ZERO "SAVED DISPLAY VALUES" FIRST...
	DO 35 N=1,75
	DO 35 NN=1,20
35	DVS(NN,N)=0.
	MODFLG=1
C INITIALLY IN NON ANSI MODE. STILL USE ANSI DRIVER FOR INPUT CONTROLS.
C NOW SET UP OTHER COMMON INFO (USED TO BE A BLOCK DATA...NOW CHANGED.)
C SETUP INITIAL DISPLAY LIMITS ACTUALLY USED.
	RRWACT=1
	RCLACT=1
	IOLVL=11
	DRWV=7
	DCLV=19
	LLCMD=22
	LLDSP=23
	ICREF=10
	IRREF=50
C SET INCREMENTS TO 1/6 OF TOTAL FOR STARTERS.
	KLVL=1
	KALKIT=0
	IRCE1=0
	IRCE2=0
	RCMODE=2
	ICODE=0
	idol3=0
	idol4=0
	idol5=20000
	idol6=20000
	RCFGX=0
	FORMFG=0
C      CALL GETADR ( PRL, NOWRAP )
      PRL ( 2 ) = 2
c	OPEN(6,FILE='CON:',STATUS='NEW',FORM='FORMATTED')
	OPEN(11,FILE='CON:20/210/450/30/Analy Command Inputs',
     1  ACTION='BOTH',ACCESS='SEQUENTIAL',FORM='FORMATTED')
c	OPEN(18,FILE='CON:20/210/450/30/Analy Cmd Prompts',
c     1  ACTION='BOTH',ACCESS='SEQUENTIAL',FORM='FORMATTED')
C LOOK FOR 'ACINIT.PRM' INITIALIZER FILE. IF ONE FOUND, READ IT.
C IF NOT, ASK AT CONSOLE FOR SINGLE/DBL PRECISION AND INITIAL VIDEO MODE
	IVV=11
C SET UP AS THOUGH WE HAD AN @ACINIT.PRM AT STARTUP AND
C ALLOW IT TO GO THRU NORMALLY...
	INQUIRE(FILE='ACINIT.PRM',EXIST=LEXIST)
	IF(.NOT.LEXIST)GOTO 6003
	OPEN(3,FILE='ACINIT.PRM',STATUS='OLD',FORM='FORMATTED')
C	CALL RASSIG(3,'ACINIT.PRM')
	IVV=3
	IOLVL=3
	GOTO 6403
6003	CONTINUE
C	OPEN(5,FILE='CON:',STATUS='OLD',FORM='FORMATTED')
C OPEN EITHER CONSOLE OR INIT FILE AT FIRST...
6403	CONTINUE
6005	FORMAT(80A1)
C For AMIGA always use "BIOS MODE" so we can have special windowing
C code in place of the Fortran I/O. Fortran console I/O will be done
C using LUN 11 in a CON: window, but most normal spreadsheet
C operations will take place in a special window over which we will have
C finer grained control...
C
	CALL SWSET(1)
	MODFLG=1
6008	CONTINUE
C SETS UP FOR USING ROM BIOS DIRECTLY FOR EVERYTHING...
C COULD THEN USE E.G. NEWKEY TO DO KEYBOARD CMDS.
	GOTO 6002
6006	CONTINUE
C ERROR ON INPUT HERE... JUST FORGET IT.
	CLOSE(3)
	IOLVL=11
C MAKE SURE LUN 5 HAS A CONSOLE FILE OPEN.
	CLOSE(11)
	OPEN(11,FILE='CON:0/50/200/60/Analy Command',
     1  STATUS='OLD',FORM='FORMATTED')
6002	CALL UVT100(18,0,0)
C PERFORM SYSTEM DEPENDENT INITIALIZATION for terminal. (none here really)
c may later read + write auxkpd.txt to set up escape seqs.
	CALL TTYINI
C
C SET UP THE SCREEN (ERASE, ETC.)
c erase screen first
	CALL UVT100(1,5,10)
	CALL UVT100(11,2,0)
c position cursor to r5c10
	CALL UVT100(1,5,10)
C ZERO THE VARIABLES TO START OFF WITH.
	DO 2070 KK=1,20
	DO 2070 KKK=1,27
2070	AVBLS(KK,KKK)=0
C SET UP WORK ARRAY BITMAP
	CALL WRKFIL(1,FORM,2)
c set reverse video title
	CALL UVT100(13,7,0)
	CALL SWRT('AnalytiCalc-68K',15)
	CALL UVT100(1,6,12)
	CALL SWRT('V22-03D',7)
	CALL UVT100(13,0,0)
	CALL UVT100(1,8,3)
	CALL SWRT(' ...The Analyst`s Tool',22)
	CALL UVT100(1,9,5)
	CALL SWRT('Copyright (C) 1988 Glenn & Mary Everhart',40)
	CALL UVT100(1,10,1)
C ALLOW SPACE FOR ASKING FOR MONEY LATER VIA PATCH IF DESIRED.
	CALL SWRT('If you use this program please send $10.00 payment',
     1  50)
	CALL UVT100(1,11,1)
	CALL SWRT('to Glenn Everhart, 25 Sleigh Ride, Glen Mills PA. ',
     1  50)
	CALL UVT100(1,12,1)
	CALL SWRT('19342 to register. May be copied for evaluation   ',
     1  50)
	Call UVT100(1,13,1)
	CALL SWRT(' purposes by recipient for others. ',35)
C NOW GET ON WITH USEFUL WORK.
      PRL ( 2 ) = 1
      PRL ( 3 ) = 0
c set ansi mode...
      CALL UVT100 ( 18 ,0,0)
	KWID=10
	KMAP=1
	RETURN
	END
c -h- acini2.for	Fri Aug 22 12:55:25 1986	
C PORTACALC MAIN PROGRAM
C SPREAD SHEET DRIVER PROGRAM
C COPYRIGHT (C) 1983,1984 GLENN AND MARY EVERHART
C ALL RIGHTS RESERVED
C MAX SHEET DIMS ARE 60 BY 300 (301 SINCE ACCUMULATORS ARE A PSEUDO ROW)
C PARAMETER 18060=60*301
C NOTE: THROUGHOUT, ROWS ARE ACTUALLY DOWN, COLUMNS ACROSS ON
C SCREEN. ROW 0 IN DISPLAY IS THE 27 ACCUMULATORS A-Z AND %, WITH
C % BEING THE LAST-COMPUTED VALUE FROM THE CALC PROGRAM, WHICH
C KNOWS HOW TO ACCESS THE DATA BUT IS JUST PASSED COMMAND STRINGS
C FROM THE DISK BASED FILE HERE.
	SUBROUTINE INITA2(KMAP,KWID,ICODE,IKONS)
C
	InTeGer*4 PRL(6)
        CHARACTER*1 NOWRAP ( 2 )
	CHARACTER*1 FORM,FVLD,CMDLIN(132)
	INTEGER*4 VNLT
	INTEGER IFCW
C	EXTERNAL LCWRQQ
	DIMENSION FORM(128),FVLD(1,1)
C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE
C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S
C SO INITIALLY IGNORE.
C
C ROUTINE IN2AS COMPUTES ASCII CHARACTER NAMES OF SUBSCRIPTS IN1,IN2
C SO DISPLAY CAN HAVE THEM. IT MUST BE THE INVERSE OF VARSCN.
C ***<<<< RDD COMMON START >>>***
	InTeGer*4 RRWACT,RCLACT
C	COMMON/RCLACT/RRWACT,RCLACT
	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8
C	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
C     1  IDOL7,IDOL8
	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
C	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
C	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	InTeGer*4 KLVL
C	COMMON/KLVL/KLVL
	InTeGer*4 IOLVL,IGOLD
C	COMMON/IOLVL/IOLVL
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
     2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
C ***<<< RDD COMMON END >>>***
CCC	InTeGer*4 RRWACT,RCLACT
CCC	COMMON/RCLACT/RRWACT,RCLACT
CCC	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
CCC     1  IDOL7,IDOL8
CCC	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
CCC     1  IDOL7,IDOL8
CCC	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
CCC	InTeGer*4 LLCMD,LLDSP
CCC	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
	DIMENSION NRDSP(20,75),NCDSP(20,75)
	COMMON/D2R/NRDSP,NCDSP
C ***<<< NULETC COMMON START >>>***
	InTeGer*4 ICREF,IRREF
C	COMMON/MIRROR/ICREF,IRREF
	InTeGer*4 MODPUB,LIMODE
C	COMMON/MODPUB/MODPUB,LIMODE
	InTeGer*4 KLKC,KLKR
	REAL*8 AACP,AACQ
C	COMMON/MSCMN/KLKC,KLKR,AACP,AACQ
	InTeGer*4 NCEL,NXINI
C	COMMON/NCEL/NCEL,NXINI
	CHARACTER*1 NAMARY(20,301)
C	COMMON/NMNMNM/NAMARY
	InTeGer*4 NULAST,LFVD
C	COMMON/NULXXX/NULAST,LFVD
	COMMON/NULETC/ICREF,IRREF,MODPUB,LIMODE,
     1  KLKC,KLKR,AACP,AACQ,NCEL,NXINI,NAMARY,NULAST,LFVD
C ***<<< NULETC COMMON END >>>***
CCC	InTeGer*4 ICREF,IRREF
CCC	COMMON/MIRROR/ICREF,IRREF
CCC	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
CCC	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	CHARACTER*1 FORM2(4)
C ***<<< XVXTCD COMMON START >>>***
	CHARACTER*1 OARRY(100)
	InTeGer*4 OSWIT,OCNTR
C	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTeGer*4 IPS1,IPS2,MODFLG
C	COMMON/ICPOS/IPS1,IPS2,MODFLG
   	InTeGer*4 XTCFG,IPSET,XTNCNT
   	CHARACTER*1 XTNCMD(80)
C   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
	INTEGER KALKIT
C	COMMON/VARYIT/KALKIT
	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
	InTeGer*4 RCMODE,IRCE1,IRCE2
C	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
C     1  IRCE2
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
C RCFGX ON.
C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
C  AND VM INHIBITS. (SETS TO 1).
	INTEGER*4 FH
C FILE HANDLE FOR CONSOLE I/O (RAW)
C	COMMON/CONSFH/FH
	CHARACTER*1 ARGSTR(52,4)
C	COMMON/ARGSTR/ARGSTR
	COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IPS1,IPS2,MODFLG,
     1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
     2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
     3  IRCE2,FH,ARGSTR
C ***<<< XVXTCD COMMON END >>>***
CCC	InTeGer*4 OSWIT,OCNTR
CCC	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTeGer*4 TYPE(1,1),VLEN(9)
CCC	InTeGer*4 KLVL
CCC	COMMON/KLVL/KLVL
CCC	InTeGer*4 IOLVL
CCC	COMMON/IOLVL/IOLVL
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	CHARACTER*1 AVBLS(20,27),VBLS(8,1,1)
	REAL*8 XXV(1,1)
	EQUIVALENCE(XXV(1,1),VBLS(1,1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
C DEFFMT IS THE DEFAULT FORMAT FOR NUMERICS. INITIALLY IT WILL BE F9.2
	CHARACTER*1 DVFMT(12),DEFFMT(10)
	EQUIVALENCE(DVFMT(2),DEFFMT(1))
	CHARACTER*12 CDVFMT
	EQUIVALENCE(CDVFMT(1:1),DVFMT(1))
	COMMON/DEFVBX/DVFMT
	CHARACTER*1 NMSH(80)
	CHARACTER*80 NMSH80
	EQUIVALENCE(NMSH80(1:1),NMSH(1))
	COMMON/NMSH/NMSH
CCC	InTeGer*4 IPS1,IPS2,MODFLG
CCC	COMMON/ICPOS/IPS1,IPS2,MODFLG
CCC   	InTeGer*4 XTCFG,IPSET,XTNCNT
CCC   	CHARACTER*1 XTNCMD(80)
CCC   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
CCC	INTEGER KALKIT
CCC	COMMON/VARYIT/KALKIT
CCC	InTeGer*4 FORMFG,RCFGX,PZAP
CCC	COMMON/FFGG/FORMFG,RCFGX,PZAP
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
C RCFGX ON.
C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
C  AND VM INHIBITS. (SETS TO 1).
C
C DISPLAY ARRAY WILL KEEP A COPY OF VARIABLES DISPLAYED AND FORMATS
C USED LOCALLY WHICH DISPLAY ROUTINE CAN USE TO SEE WHAT ACTUALLY
C NEEDS TO BE REFRESHED ON SCREEN. DRWV AND DCLV ARE COLS, ROWS OF
C DISPLAY ACTUALLY USED FOR SCREEN.
	InTeGer*4 CWIDS(20)
C CWIDS IS WIDTHS IN CHARACTERS OF COLUMNS ON DISPLAY. NOTE THAT BECAUSE
C OF PECULIAR INVERSION WHICH I AM TOO LAZY TO CORRECT IT IS DIMENSIONED
C AS 20 NOT 75.
	INTEGER*4 I4TMP
	REAL*8 DVS(20,75)
	COMMON /FVLDC/FVLD
C FOLLOWING SUPPORT VVARY OVERLAY:
	REAL*8 QQAC(26),QDERIV(8),QDEL(8),OLDVV,OLDX,OLDA
	InTeGer*4 QCAC,QCENT(8),ACV(8)
	COMMON/VRYDAT/QQAC,QDERIV,QDEL,QCAC,QCENT,OLDVV,OLDX,OLDA,ACV
C BITMAP
C	CHARACTER*1 IBITMP
C	DIMENSION IBITMP(2258)
C	COMMON/INITD/IBITMP
C	CHARACTER*1 DFMTS(10,20,75)
C 10 CHARACTERS PER ENTRY.
	COMMON/DSPCMN/DVS,CWIDS
	character*35 fwt
C ***<<< KLSTO COMMON START >>>***
	InTeGer*4 DLFG
C	COMMON/DLFG/DLFG
	InTeGer*4 KDRW,KDCL
C	COMMON/DOT/KDRW,KDCL
	InTeGer*4 DTRENA
C	COMMON/DTRCMN/DTRENA
	REAL*8 EP,PV,FV
	DIMENSION EP(20)
	INTEGER*4 KIRR
C	COMMON/ERNPER/EP,PV,FV,KIRR
	InTeGer*4 LASTOP
C	COMMON/ERROR/LASTOP
	CHARACTER*1 FMTDAT(9,76)
C	COMMON/FMTBFR/FMTDAT
	CHARACTER*1 EDNAM(16)
C	COMMON/EDNAM/EDNAM
	InTeGer*4 MFID(2),MFMOD(2)
C	COMMON/FRM/MFID,MFMOD
	InTeGer*4 JMVFG,JMVOLD
C	COMMON/FUBAR/JMVFG,JMVOLD
	COMMON/KLSTO/DLFG,KDRW,KDCL,DTRENA,EP,PV,FV,KIRR,
     1  LASTOP,FMTDAT,EDNAM,MFID,MFMOD,JMVFG,JMVOLD
C ***<<< KLSTO COMMON END >>>***
CCC	CHARACTER*1 EDNAM(16)
CCC	COMMON/EDNAM/EDNAM
	CHARACTER*1 EDNINI(4)
	DATA EDNINI/'E','D','I','T'/
C	DATA NOWRAP / "24,0 /
C
	DO 2900 III=1,16
2900	EDNAM(III)=' '
	DO 2901 III=1,4
2901	EDNAM(III)=EDNINI(III)
	IF(IKONS.EQ.0)GOTO 3000
3002	CONTINUE
	CALL UVT100(1,1,1)
	CALL VWRT('Alter Widths or Mapping Y/N:',28)
	ILL=IOLVL
C	IF(ILL.EQ.5)ILL=0
	READ(ILL,3006,END=5600,ERR=5600)FORM
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')GOTO 3000
	CALL VWRT('Enter NEW Global Column Width 1-120:',36)
C ALTER MAPPING DESIRED
	READ(ILL,3004,END=5600,ERR=5600)KWID
3004	FORMAT(I3)
	IF(KWID.LT.1.OR.KWID.GT.120)KWID=10
	CALL VWRT('Enter length of display in lines (nominally 24):',48)
	READ(ILL,3004,END=5600,ERR=5600)III
	IF(III.LE.4.OR.III.GT.999)III=24
C RESET DISPLAY SIZE IN S COMMAND QUESTIONS AS NEEDED.
	LLDSP=III
	LLCMD=III-1
	CALL VWRT('Change annotate editor from "EDIT" [Y/N]:',41)
	READ(ILL,3006,END=5600,ERR=5600)FORM
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')GOTO 3031
	CALL VWRT('Give desired edit command:',26)
	READ(ILL,3006,END=5600,ERR=5600)EDNAM
	EDNAM(16)=' '
C ENSURE THERE'S A SPACE AT END OF EDITOR NAME
3031	CONTINUE
	CALL VWRT('Modify Extended Area Remap Y/N: ',31)
	READ(ILL,3006,END=5600,ERR=5600)FORM
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')GOTO 3502
	CALL VWRT('# cols to move over on row overflow:',36)
	READ(ILL,3004,END=5600,ERR=5600)ICREF
	IF(ICREF.GT.60)ICREF=10
	IF(ICREF.LT.0)ICREF=10
	CALL VWRT('# rows to move down on col overflow:',34)
	READ(ILL,3004,END=5600,ERR=5600)IRREF
	IF(IRREF.GT.300)IRREF=50
	IF(IRREF.LT.0)IRREF=50
C FORCE THE RESULTS TO MAKE SENSE. 0 TO 60 ON COLS, 0-300 ON ROWS.
C IF USER BOTHERS TO READ MANUALS THIS WILL BE EXPLAINED.
3502	CONTINUE
	CALL VWRT('Reset Display to Upper Left of Sheet Y/N:',40)
	READ(ILL,3006,END=5600,ERR=5600)FORM
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')KMAP=0
3006	FORMAT(80A1,50A1)
3000	CONTINUE
	RETURN
5600	CONTINUE
	IOLVL=11
	CLOSE(3)
	Rewind 11
c	CLOSE(11)
c	OPEN(11,FILE='CON:0/0/100/100/Analy Command',
c     1  STATUS='OLD',FORM='FORMATTED')
	RETURN
	END
c -h- acini3.for	Fri Aug 22 12:55:39 1986	
C PORTACALC MAIN PROGRAM
C SPREAD SHEET DRIVER PROGRAM
C COPYRIGHT (C) 1983,1984 GLENN AND MARY EVERHART
C ALL RIGHTS RESERVED
C MAX SHEET DIMS ARE 60 BY 300 (301 SINCE ACCUMULATORS ARE A PSEUDO ROW)
C PARAMETER 18060=60*301
C NOTE: THROUGHOUT, ROWS ARE ACTUALLY DOWN, COLUMNS ACROSS ON
C SCREEN. ROW 0 IN DISPLAY IS THE 27 ACCUMULATORS A-Z AND %, WITH
C % BEING THE LAST-COMPUTED VALUE FROM THE CALC PROGRAM, WHICH
C KNOWS HOW TO ACCESS THE DATA BUT IS JUST PASSED COMMAND STRINGS
C FROM THE DISK BASED FILE HERE.
	SUBROUTINE INITB(KMAP,KWID,ICODE)
C
	InTeGer*4 PRL(6)
        CHARACTER*1 NOWRAP ( 2 )
	CHARACTER*1 FORM,FVLD,CMDLIN(132)
	INTEGER*4 VNLT
	INTEGER IFCW
C	EXTERNAL LCWRQQ
	DIMENSION FORM(128),FVLD(1,1)
C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE
C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S
C SO INITIALLY IGNORE.
C
C ROUTINE IN2AS COMPUTES ASCII CHARACTER NAMES OF SUBSCRIPTS IN1,IN2
C SO DISPLAY CAN HAVE THEM. IT MUST BE THE INVERSE OF VARSCN.
C ***<<<< RDD COMMON START >>>***
	InTeGer*4 RRWACT,RCLACT
C	COMMON/RCLACT/RRWACT,RCLACT
	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8
C	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
C     1  IDOL7,IDOL8
	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
C	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
C	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	InTeGer*4 KLVL
C	COMMON/KLVL/KLVL
	InTeGer*4 IOLVL,IGOLD
C	COMMON/IOLVL/IOLVL
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
     2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
C ***<<< RDD COMMON END >>>***
CCC	InTeGer*4 RRWACT,RCLACT
CCC	COMMON/RCLACT/RRWACT,RCLACT
CCC	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
CCC     1  IDOL7,IDOL8
CCC	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
CCC     1  IDOL7,IDOL8
CCC	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
CCC	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(20,75),NCDSP(20,75)
	COMMON/D2R/NRDSP,NCDSP
CCC	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
CCC	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	CHARACTER*1 FORM2(4)
d	Integer*4 ill
C ***<<< XVXTCD COMMON START >>>***
	CHARACTER*1 OARRY(100)
	InTeGer*4 OSWIT,OCNTR
C	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTeGer*4 IPS1,IPS2,MODFLG
C	COMMON/ICPOS/IPS1,IPS2,MODFLG
   	InTeGer*4 XTCFG,IPSET,XTNCNT
   	CHARACTER*1 XTNCMD(80)
C   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
	INTEGER KALKIT
C	COMMON/VARYIT/KALKIT
	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
	InTeGer*4 RCMODE,IRCE1,IRCE2
C	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
C     1  IRCE2
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
C RCFGX ON.
C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
C  AND VM INHIBITS. (SETS TO 1).
	INTEGER*4 FH
C FILE HANDLE FOR CONSOLE I/O (RAW)
C	COMMON/CONSFH/FH
	CHARACTER*1 ARGSTR(52,4)
C	COMMON/ARGSTR/ARGSTR
	COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IPS1,IPS2,MODFLG,
     1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
     2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
     3  IRCE2,FH,ARGSTR
C ***<<< XVXTCD COMMON END >>>***
CCC	InTeGer*4 OSWIT,OCNTR

CCC	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTeGer*4 TYPE(1,1),VLEN(9)
CCC	InTeGer*4 KLVL
CCC	COMMON/KLVL/KLVL
CCC	InTeGer*4 IOLVL
CCC	COMMON/IOLVL/IOLVL
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	CHARACTER*1 AVBLS(20,27),VBLS(8,1,1)
	REAL*8 XXV(1,1)
	EQUIVALENCE(XXV(1,1),VBLS(1,1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
C DEFFMT IS THE DEFAULT FORMAT FOR NUMERICS. INITIALLY IT WILL BE F9.2
	CHARACTER*1 DVFMT(12),DEFFMT(10)
	CHARACTER*12 CDVFMT
	EQUIVALENCE(DEFFMT(1),DVFMT(2))
	EQUIVALENCE(CDVFMT(1:1),DVFMT(1))
	COMMON/DEFVBX/DVFMT
	CHARACTER*1 NMSH(80)
	CHARACTER*80 NMSH80
	EQUIVALENCE(NMSH80(1:1),FORM(1))
	COMMON/NMSH/NMSH
CCC	InTeGer*4 IPS1,IPS2,MODFLG
CCC	COMMON/ICPOS/IPS1,IPS2,MODFLG
CCC   	InTeGer*4 XTCFG,IPSET,XTNCNT
CCC   	CHARACTER*1 XTNCMD(80)
CCC   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
CCC	INTEGER KALKIT
CCC	COMMON/VARYIT/KALKIT
CCC	InTeGer*4 FORMFG,RCFGX,PZAP
CCC	COMMON/FFGG/FORMFG,RCFGX,PZAP
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
C RCFGX ON.
C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
C  AND VM INHIBITS. (SETS TO 1).
C
C DISPLAY ARRAY WILL KEEP A COPY OF VARIABLES DISPLAYED AND FORMATS
C USED LOCALLY WHICH DISPLAY ROUTINE CAN USE TO SEE WHAT ACTUALLY
C NEEDS TO BE REFRESHED ON SCREEN. DRWV AND DCLV ARE COLS, ROWS OF
C DISPLAY ACTUALLY USED FOR SCREEN.
	InTeGer*4 CWIDS(20)
C CWIDS IS WIDTHS IN CHARACTERS OF COLUMNS ON DISPLAY. NOTE THAT BECAUSE
C OF PECULIAR INVERSION WHICH I AM TOO LAZY TO CORRECT IT IS DIMENSIONED
C AS 20 NOT 75.
	INTEGER*4 I4TMP
	REAL*8 DVS(20,75)
	COMMON /FVLDC/FVLD
C FOLLOWING SUPPORT VVARY OVERLAY:
	REAL*8 QQAC(26),QDERIV(8),QDEL(8),OLDVV,OLDX,OLDA
	InTeGer*4 QCAC,QCENT(8),ACV(8)
	COMMON/VRYDAT/QQAC,QDERIV,QDEL,QCAC,QCENT,OLDVV,OLDX,OLDA,ACV
C BITMAP
C	CHARACTER*1 IBITMP
C	DIMENSION IBITMP(2258)
C	COMMON/INITD/IBITMP
C	CHARACTER*1 DFMTS(10,20,75)
C 10 CHARACTERS PER ENTRY.
	COMMON/DSPCMN/DVS,CWIDS
	character*35 fwt
d       Integer*4 ifubar
d	Dimension ifubar(12)
C	DATA NOWRAP / "24,0 /
C
	idol5=20000
	idol6=20000
C INITIALLY SET JRCL TO 301 = NO. OF ROWS TO BE IN WORK FILE
	JRCL=301
	PZAP=0
	XTCFG=0
	IPSET=0
C ZERO BITMAP
C	DO 36 N1=1,2258
C36	IBITMP(N1)=0
c	LINIZZ=0
	CALL UVT100(1,14,1)
	CALL VWRT('Enter NEW floating format default Y/N:',38)
	ILL=IOLVL
C	IF(ILL.EQ.5)ILL=0
	READ(ILL,3006,END=5600,ERR=5600)FORM
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')GOTO 3589
C ENTER NEW DEFAULT.
6888	CALL UVT100(1,14,1)
	CALL UVT100(12,2,0)
C LINE NOW ERASED... GET NEW FORMAT
	CALL VWRT('Enter new format. Suggest F10.2>',32)
	READ(ILL,3006,END=5600,ERR=5600)FORM
C NOW HAVE HIS DESIRED FORMAT. COPY INTO THE DEFAULT ARRAY.
C DEFFMT IS THAT.
	DO 3591 N1=1,10
	KKK=ICHAR(FORM(N1))
	KKK=MAX0(32,KKK)
C ASSUME NMSH COMPLETELY INIT'D
3591	DEFFMT(N1)=Char(KKK)
c	dvfmt(1)='('
c	dvfmt(12)=')'
C CHECK ITS LEGALITY BY TRYING TO USE IT ONCE.
	XX=3.14159
	WRITE(NMSH80(1:80),DVFMT,ERR=6888)XX
C	ENCODE(78,DVFMT,NMSH,ERR=6888)XX
C IF IT FAILS, PROGRAM WILL CRASH AND FILE WON'T GET CLOBBERED.
3589	CONTINUE
	CALL UVT100(1,15,1)
	CALL VWRT('Title for Spreadsheet:',22)
	ILL=IOLVL
C	IF(ILL.EQ.5)ILL=0
	READ(ILL,3006,END=5600,ERR=5600)FORM
3006	FORMAT(80A1,50A1)
	IF(ICHAR(FORM(1)).LE.32.AND.ICHAR(FORM(2)).LE.32) GOTO 3008
C COPY TITLE UNLESS IT'S OLD
	DO 3007 KKK=1,80
3007	NMSH(KKK)=FORM(KKK)
C THAT WAY JUST C.R. LEAVES IN OLD TITLE.
3008	CONTINUE
C ****** IF S OPTION GIVEN THEN ICODE=-2
C THEREFORE, DON'T ASK DISK SIZE ETC, BUT ALLOW RESET OF TITLE
C AND DEFAULT FORMATS.
	IF(ICODE.EQ.-2) GOTO 7831
C ******
	CALL UVT100(1,16,1)
	CALL VWRT('Give Max Rows to be used:',25)
	READ(ILL,7202,END=5600,ERR=5600)KR
	IF(KR.LE.0)KR=301
	CALL UVT100(1,17,1)
	CALL VWRT('Give Max Cols to be used:',25)
	READ(ILL,7202,END=5600,ERR=5600)KC
	IF(KC.LE.0)KC=60
C	KKK=(KR-1)*60+KC
C ALLOW REPLIES IN ANY RANGE AND REFLECT BACK TO PRIME RANGE
C NOTE WE WANT A CELL ADDRESS HERE FOR THE END CELL...
	CALL REFLEC(KR,KC,KKK)
	XKKKK=KR*KC
	XKDF=XKKKK/64.
	XKDN=XKKKK/100.
C COMPUTED ABOVE THE MIN # OF K FOR DISK FILES
	CALL UVT100(1,18,1)
	write(fwt(1:12),2058)xkdn
2058	format(F9.0)
	CALL SWRT('Min=',4)
	call swrt(fwt(1:12),9)
	write(fwt,2058)xkdf
	call swrt(' K Value file ',14)
	CALL SWRT(fwt(1:12),9)
	CALL SWRT(' K Formula file',15)
c	WRITE(0,2058)XKDN,XKDF
c2058	FORMAT(' Mins=',F9.0' K Value file, ',F9.0,' K Formula file',\)
C KKK IS MAX INDEX TO BE USED HERE.
	CALL UVT100(1,21,1)
	CALL VWRT('Give Value File size, K:',24)
	READ(ILL,7202,END=5600,ERR=5600)IPGMAX
7202	FORMAT(I6)
	IPGMOD=KKK
	IF(IPGMAX.LT.0)IPGMOD=0
	IPGMAX=IABS(IPGMAX)
	IF(IPGMAX.GT.2512)IPGMAX=1
	CALL UVT100(1,22,1)
	CALL VWRT('Give Formula File size, K:',26)
	READ(ILL,7202,END=5600,ERR=5600)LPGMXF
	LPGMOD=KKK
	IF(LPGMXF.LT.0)LPGMOD=0
	LPGMXF=IABS(LPGMXF)
C IF NUMBERS ARE ENTERED NEGATIVE, SET MODE TO "SLOW, FILE-SPACE
C CONSERVING" PACKING, SCATTERING PAGES ACROSS FILE.
	IF(LPGMXF.GT.4096)LPGMXF=(IPGMAX*3)/2
C NULL TERMINATE ALL FORMAT STRINGS.
C SET MAX WIDTH FOR PRINT TO DIMENSION OF THE BUFFER. NOTE THIS IS THE
C USUAL HARDWARE MAXIMUM SO WE DON'T WORRY TOO MUCH ABOUT IT. NOTE
C BILL TABOR'S PROGRAM TO PRINT PASTE-ABLE VERSIONS OF THE SHEET FROM
C SAVE FILES EXISTS, SO WE NEEDN'T WORRY TOO MUCH EITHER ABOUT USING
C DISPLAY FOR DOUBLE DUTY.
	MXL=132
C INITIALIZE WORK STORAGE FOR FORMULAS AND VARIABLES
	CALL WSSET
7831	CONTINUE
C SET DEFAULT WIDTHS OF COLUMNS TO 10. MAY BE ALTERED BELOW FOR DIFFERENT
C DEFAULT IF DESIRED.
	DO 16 N1=1,20
	CWIDS(N1)=KWID
16	CONTINUE
C
C NOW SET UP NRDSP, NCDSP
	IF(KMAP.EQ.0)GOTO 3009
C SET UP MAPPING NOW FOR INITIALLY UPPER LEFT CORNER OF PHYS SHEET IN DISPLAY SHT.
	DO 5 N1=1,20
	DO 5 N2=1,75
C INITIALLY WE DISPLAY THE UPPER LEFT PART OF THE SYSTEM.
C ESTABLISH ASSOCIATION INITIALLY THEREFORE OF DISPLAY TO UPPER
C LEFT OF PHYSICAL SHEET.
	NRDSP(N1,N2)=N1
	NCDSP(N1,N2)=N2+1
	DVS(N1,N2)=.00000031
5	CONTINUE
C FOR S OPTION USE SECRET -4 CODE TO RESET SHEET. STILL NEEDS WORK
C IN PORTACALC PC.
	IF(ICODE.EQ.-4)CALL WRKFIL(1,FORM,2)
3009	IF(ICODE.EQ.-4)GOTO 1
C43	CALL UVT100(1,21,1)
	KZPPD=0
	CMDLIN(1)=0
	IOLDFL=0
C3017	FORMAT(Q,80A1,80A1)
	MXL=1
	CMDLIN(MXL+1)=0
3572	FORMAT(I6)
	CALL UVT100(13,0,0)
C  SET UP RANDOM FILE AS NEEDED FOR SHEET
C EACH RECORD HAS:
C CHARS 1-110	FORMULAS
C CHARS 120-128	DISPLAY FORMAT (INITIALLY F9.2)
C CHAR 119	VALID FLAG (ALLOWS HANDLING READS.)
C    values: -3, -2: Numeric-only text (or special chars)
C	     -1    : Alphanumeric text
C	      0    : Uninitialized
C	      1    : Alphanumeric formula
C	     +2    : Number or pure numeric formula with value calculated
C	     +3    : Number or pure numeric formula, value not yet computed
C CHAR 118	MAGIC NUMBER 15 (CHECKS ALL WELL)
C READ A RECORD, IF ERROR, CREATE EMPTY FILE.
C	IF(IOLDFL.EQ.0)GOTO 1
CC IF IOLDFL NONZERO IT MEANS USER CLAIMS THERE EXISTS A FILE. IF 0 IT'S NEW.
CC HERE IT'S OLD SO LET'S BE SURE IT REALLY IS OK.
1	CONTINUE
C HIT EOF OR ERROR. MUST BE A NEW FILE. THEREFORE ZERO IT TO OUR NEEDS.
C AT THIS POINT WE ARE CREATING A NEW FILE AND NEED TO ZERO IT.
C
	DO 3 N=1,128
	FORM(N)=0
3	CONTINUE
	DO 3592 N=1,9
C SET UP DEFAULT FORMAT
3592	FORM(119+N)=DEFFMT(N)
	FORM(118)=CHAR(15)
	FORM(1)='0'
	FORM(2)='.'
C CREATE NULL FILE INITIALLY BY RESETTING ALL.
	JRRCL=60*JRCL
	KZPPD=1
C
2	CONTINUE
C COMMON POINT WITH FILE PREPARED.
	PCOL=2
	PROW=1
	DCOL=1
	DROW=1
	RETURN
5600	CONTINUE
C ERROR ON READ FROM IOLVL HANDLED HERE.
C	REWIND 5
	Rewind 11
c	CLOSE(11)
c	OPEN(11,FILE='CON:0/150/500/49/Analy Command',
c     1  STATUS='OLD',FORM='FORMATTED')
	CLOSE(3)
	IOLVL=11
	RETURN
	END
c -h- block.for	Fri Aug 22 12:58:14 1986	
	SUBROUTINE BLOCK
C	BLOCK DATA
C COPYRIGHT (C) 1983 GLENN EVERHART
C ALL RIGHTS RESERVED
C 18060 = 60*301
C 18033=18060-27
C 60=MAX REAL ROWS
C 301=MAX REAL COLS
C 60 MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS
C VBLS AND TYPE DIMENSIONED 60,301
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C   +                                                +
C   +            CALC    VERSION  X01-06             +
C   +                                                +
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C *******************************************************
C *                                                     *
C *            BLOCK  DATA  MODULE                      *
C *                                                     *
C *******************************************************
C
C
C COMMON AREAS ARE INITIALIZED BY THIS MODULE.
C FAKEUP FOR MICROSOFT WHICH HAS NO BLOCK DATA.
C DO IT ALL VIA LOOPS...
C
C
C MODIFIED 18-MAY-1981 P.B. SET % TO VERSION 6
C
C
C
C   VARIABLE      USE
C
C  ALPHA(27)    HOLDS LEGAL VARIABLE NAMES: ALPHABETIC CHARACTERS
C               OR THE CHARACTER %.
C  BASED     HOLDS DEFAULT BASE.
C  BLANK        ' '
C  COMMA        ','
C  DIGITS(16,3) HOLDS DECIMAL, OCTAL, AND HEXADECIMAL DIGITS. THE
C               SECOND SUBSCRIPT IS
C                     1 FOR DECIMAL
C                     2 FOR OCTAL
C                     3 FOR HEXADECIMAL
C  DTBL1(9,9,8) CONTROLS THE DECISION PROCESS WHEN EVALUATING A
C               BINARY OPERATION. SEE BELOW FOR DETAILS.
C  EQ           '='
C  ITCNTV(6)    INDEXED BY LEVEL. 0 INDICATES THAT NO ITERATION ON THE
C               INDIRECT COMMAND FILE IS TO TAKE PLACE. IF POSITIVE, IT
C               HOLDS THE INDEX INTO VBLS AND REPRESENTS THE VARIABLE
C               USED TO CONTROL ITERATION.
C  LINE(80)     COMMAND INPUT LINE
C  LPAR         '('
C  RPAR         ')'
C  ST1LIM       HOLDS THE SIZE OF STACK 1 (ALWAYS CONSTANT)
C  ST2LIM       HOLDS THE SIZE OF STACK 2 (ALWAYS CONSTANT)
C  ST1PT        POINTS TO THE TOP OF STACK 1 (CHANGES AS STACK IS USED)
C  ST2PT        POINTS TO THE TOP OF STACK 2 (CHANGES AS STACK IS USED)
C  ST1TYP(40)       DATA TYPE FOR EACH ELEMENT IN STACK 1
C  ST2TYP(40)       DATA TYPE FOR EACH ELEMENT IN STACK 2
C  STACK1(20,40)   UTILITY STACKS USED WHEN EVALUATING EXPRESSIONS. THE FIRST
C  STACK2(20,40)   SUBSCRIPT CONTROLS INDEXING ACROSS THE BYTES OF A SINGLE
C                   VARIABLE. THE SECOND SUBSCRIPT CONTROLS STACK ELEMENTS.
C  TYPE(27)         HOLDS THE DATA TYPES FOR EACH OF THE 27 VARIABLES. SEE
C                   CODES.FTN FOR THE POSSIBLE VALUES.
C  VIEWSW           VIEW SWITCH
C                    0 = OUTPUT ERROR MESSAGES
C                    1 = OUTPUT ERROR MESSAGES AND FILE COMMAND LINES
C                    2 = OUTPUT ERROR MESSAGES AND VALUE OF EXPRESSIONS
C                        EVALUATED.
C                    3 = OUTPUT EVERYTHING
C  VLEN(9)      INDEXED BY DATA TYPE. GIVES THE NUMBER OF BYTES USED
C               BY THAT DATA TYPE.
C  AVBLS(20,27)      HOLDS THE VALUES OF THE 27 LEGAL VARIABLES.(ACCUMULATORS)
C  VBLS(8,60,301)    HOLDS VALUES OF ALL VARIABLES
C
C
C
C    CONSTANTS ARE STORED IN VBLS ACCORDING TO THEIR TYPE:
C
C
C
C <----------- MULTIPLE PRECISION (M10, M8, M16) ------------------------->
C !                        <------------- DECIMAL AND REAL --------------->
C !                        !                      <-- INTEGER HEX OCTAL -->
C !                                               !             ---> ASCII <---
C !                        !                      !                        !
C
C -------------     -------------------------------------------------------
C !     !     !     !     !     !     !     !     !     !     !     !     !
C ! 20  !  19 ! ... !  9  !  8  !  7  !  6  !  5  !  4  !  3  !  2  !  1  !
C !     !     !     !     !     !     !     !     !     !     !     !     !
C -------------     -------------------------------------------------------
C
C
C NOTE: BYTE 20 HOLDS THE SIGN FOR MULTIPLE PRECISION NUMBERS.
C       0 = POSITIVE, 1 = NEGATIVE
C
C
C
C
C
C	BLOCK DATA
	InTeGer*4 LEVEL,NONBLK,LEND
	InTeGer*4 LASTOP
	InTeGer*4 ST1TYP(40),ST2TYP(40)
	InTeGer*4 TYPE(1,1)
	InTeGer*4 VIEWSW,BASED,VLEN(9),BVLEN(9)
	InTeGer*4 ST1LIM,ST2LIM,ST1PT,ST2PT
	InTeGer*4 ITCNTV(6)
C
	CHARACTER*1 ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ,LINE(80)
	CHARACTER*1 BOMMA,BBLANK,BRPAR,BLPAR,BEQ
	CHARACTER*1 STACK1(8,40),STACK2(8,40)
	CHARACTER*1 AVBLS(20,27),BLPHA(27)
	CHARACTER*1 VBLS(8,1,1)
C ***<<< XVXTCD COMMON START >>>***
	CHARACTER*1 OARRY(100)
d	integer*4 ill
	InTeGer*4 OSWIT,OCNTR
C	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTeGer*4 IC1POS,IC2POS,MODFLG
C	COMMON/ICPOS/IPS1,IPS2,MODFLG
   	InTeGer*4 XTCFG,IPSET,XTNCNT
   	CHARACTER*1 XTNCMD(80)
C   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
	INTEGER KALKIT
C	COMMON/VARYIT/KALKIT
	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
	InTeGer*4 RCMODE,IRCE1,IRCE2
C	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
C     1  IRCE2
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
C RCFGX ON.
C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
C  AND VM INHIBITS. (SETS TO 1).
	INTEGER*4 FH
C FILE HANDLE FOR CONSOLE I/O (RAW)
C	COMMON/CONSFH/FH
	CHARACTER*1 ARGSTR(52,4)
C	COMMON/ARGSTR/ARGSTR
	COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IC1POS,IC2POS,MODFLG,
     1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
     2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
     3  IRCE2,FH,ARGSTR
C ***<<< XVXTCD COMMON END >>>***
CCC	InTeGer*4 IC1POS,IC2POS
CCC	COMMON/ICPOS/IC1POS,IC2POS
	CHARACTER*1 DTBL1(9,9,8)
CC BIG WASTEFUL TABLE TO INIT OPERATION TYPE DATA. TRY TO REUSE SPACE.
C MOVED TABLE TO WRKFIL WHERE IT IS OVERLAIN BY A BUFFER DURING OPERATION
C AND JUST INITIALIZES DTBL1 AT STARTUP. THIS SHOULD ESSENTIALLY REMOVE DATA
C SPACE PENALTY FOR THIS HUGE ARRAY. NOTE IT'D BE SMALLER IF THERE WEREN'T
C SO MANY SUPPORTED DATA TYPES IN CALC.
C	InTeGer*4 BTBL(9,9,8)
C	InTeGer*4 BTBL1(9,9)
C	InTeGer*4 BTBL2(9,9),BTBL3(9,9),BTBL4(9,9),BTBL5(9,9)
C	InTeGer*4 BTBL6(9,9),BTBL7(9,9),BTBL8(9,9)
C	EQUIVALENCE(BTBL(1,1,1),BTBL1(1,1)),(BTBL(1,1,2),BTBL2(1,1))
C	EQUIVALENCE(BTBL(1,1,3),BTBL3(1,1)),(BTBL(1,1,4),BTBL4(1,1))
C	EQUIVALENCE(BTBL(1,1,5),BTBL5(1,1)),(BTBL(1,1,6),BTBL6(1,1))
C	EQUIVALENCE(BTBL(1,1,7),BTBL7(1,1)),(BTBL(1,1,8),BTBL8(1,1))
	CHARACTER*1 DIGITS(16,3),BIGITS(16,3)
C
C OARRY WILL BE USED TO HOLD OUTPUT VARIABLE IF OSWIT IS NONZERO
CCC	InTeGer*4 OSWIT
C OCNTR MAY HOLD BYTES VALID IN OARRY (UP TO 100, NO MORE...)
CCC	InTeGer*4 OCNTR
CCC	CHARACTER*1 OARRY(100)
C
C ILINE IS PROGRAMMABLE LINE INPUT (I.E., NOT FROM CONSOLE)
	CHARACTER*1 ILINE(106)
	InTeGer*4 ILNFG
	InTeGer*4 ILNCT
	COMMON /ILN/ILNFG,ILNCT,ILINE
C ILINE IS PRESENT IF ILNFG <> 0 AND ILNCT HAS # BYTES IN IT.
CCC	COMMON /OAR/OSWIT,OCNTR,OARRY
	COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
	COMMON /CONS/ALPHA,COMMA,BLANK,RPAR,LPAR,EQ
	COMMON /STACK/ STACK1,STACK2,ST1PT,ST2PT,ST1TYP,ST2TYP,
     ;         ST1LIM,ST2LIM
	COMMON /V/ TYPE,AVBLS,VBLS,VLEN
	COMMON /DECIDE/ DTBL1
	COMMON /DIGV/ DIGITS
C ***<<< KLSTO COMMON START >>>***
	InTeGer*4 DLFG
C	COMMON/DLFG/DLFG
	InTeGer*4 KDRW,KDCL
C	COMMON/DOT/KDRW,KDCL
	InTeGer*4 DTRENA
C	COMMON/DTRCMN/DTRENA
	REAL*8 EP,PV,FV
	DIMENSION EP(20)
	INTEGER*4 KIRR
C	COMMON/ERNPER/EP,PV,FV,KIRR
c	InTeGer*4 LASTOP
C	COMMON/ERROR/LASTOP
	CHARACTER*1 FMTDAT(9,76)
C	COMMON/FMTBFR/FMTDAT
	CHARACTER*1 EDNAM(16)
C	COMMON/EDNAM/EDNAM
	InTeGer*4 MFID(2),MFMOD(2)
C	COMMON/FRM/MFID,MFMOD
	InTeGer*4 JMVFG,JMVOLD
C	COMMON/FUBAR/JMVFG,JMVOLD
	COMMON/KLSTO/DLFG,KDRW,KDCL,DTRENA,EP,PV,FV,KIRR,
     1  LASTOP,FMTDAT,EDNAM,MFID,MFMOD,JMVFG,JMVOLD
C ***<<< KLSTO COMMON END >>>***
CCC	COMMON /ERROR/ LASTOP
	COMMON/ITERA/ ITCNTV
	CHARACTER*1 DVFMT(12),BVFMT(12)
	COMMON/DEFVBX/DVFMT
C SUPPORT VVARY OVERLAY WITH INITIAL VARY DATA:
	REAL*8 QAC(26),QDERIV(8),QDEL(8),QOLDVV
	InTeGer*4 QCAC,QCENT(8),ACV(8)
	COMMON/VRYDAT/QAC,QDERIV,QDEL,QCAC,QCENT,QOLDVV,ACV
C INITIAL DEFAULT FORMAT FOR NUMERICS
	DATA BVFMT/'(','F','9','.','2',' ',
     1  ' ',' ',' ',' ',' ',')'/
C
C	DATA BIEWSW/2/
C	DATA ITCNTV/6*0/
	DATA BLPHA/'A','B','C','D','E','F','G','H','I','J','K','L','M',
     ;       'N','O','P','Q','R','S','T','U','V','W','X','Y','Z','%'/
	DATA BIGITS/'1','2','3','4','5','6','7','8','9',
     1  '0','0','0','0','0','0','0',
     ;       '1','2','3','4','5','6','7',
     1  '0','0','0','0','0','0','0','0','0',
     ;  '1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','0'/
	DATA BOMMA/','/,BBLANK/' '/,BRPAR/')'/,BLPAR/'('/,BEQ/'='/
C
C
C DEFAULT BASE IS 10
C	DATA BASED/10/
C
C
C STACKS ARE CURRENTLY SET AT 40 ELEMENTS DEEP
C	DATA ST1LIM/40/, ST2LIM/40/
C
C
C
C	DEFAULT TYPES
C	A,B,C,D,E,F,G,H  =  DECIMAL
C	I,J,K,L,M,N      =  INTEGER (BASE10)
C	O,P,Q,R,S,T,U,V,W,X,Y,Z  =  DECIMAL
C
C  % AS INTEGER TO HOLD CALC VERSION NUMBER
C
C	DATA TYPE/8*2,6*4,12*2,4,1*2/
c modify type array so ac's i-n are reals
C	DATA TYPE/8*2,6*2,12*2,2,1*2/
C
C
C GIVE VERSION # BY VALUE IN %
C
c don't bother with this; by the time user gets into calc,
c % already is clobbered most times, so no need for it.
c	DATA AVBLS(1,27)/6/
c	DATA AVBLS(2,27)/0/,AVBLS(3,27)/0/,AVBLS(4,27)/0/
C
C
C
C
C SPECIFY THE LENGTH USED BY EACH DATA TYPE
	DATA BVLEN/1,8,4,4,8,8,8,4,8/
C
C NOTE ALL LENGTHS 8 OR LESS SINCE MULTIPLE PRECISION THINGS SNIPPED OUT
C
C  DECISION TABLE FOR PERFORMING BINARY OPERATIONS
C
C  DTBL1(OPERAND2,OPERAND1,INDEX)
C
C  WHERE:					OPERATOR:
C  INDEX=1	MODIFY CODE FOR OPERAND 1	*/+-
C	 2	MODIFY CODE FOR OPERAND 2	*/+-
C	 3	FUNCTION VALUE TYPE		*/+-
C	 4	OPERATOR CLASS			*/+-
C
C	 5	MODIFY CODE FOR OPERAND 1	**
C	 6	MODIFY CODE FOR OPERAND 2	**
C	 7	FUNCTION VALUE TYPE		**
C	 8	OPERATOR CLASS			**
C
C
C  WHERE TYPE CODES (MODIFY CODES) ARE:
C	0	NO CHANGE
C	1	CONVERT TO ASCII
C	2	CONVERT TO DECIMAL
C	3	CONVERT TO HEXADECIMAL
C	4	CONVERT TO INTEGER
C	5	CONVERT TO M10
C	6	CONVERT TO M8
C	7	CONVERT TO M16
C	8	CONVERT TO OCTAL
C	9	CONVERT TO REAL
C
C  FOR */+- FUNCTION VALUE TYPES AND OPERATOR CLASS ARE PRESENTLY
C  IDENTICAL
C
C  FOR **  OPERATOR CLASSES FOLLOW:
C
C 	CODE	OPERATOR CLASS
C	1	REAL**REAL
C	2	REAL**INTEGER
C	3	INTEGER**REAL
C	4	INTEGER**REAL
C	5	M8**INTEGER
C	6	M10**INTEGER
C	7	M16**INTEGER
C
C
C
C	DATA BTBL1 /4,2,3,4,5,6,7,8,9,
C     1  9*0,0,2,0,0,3*7,0,9,0,2,0,0,5,5,7,0,9,0,2,7,0,0,0,7,0,9,
C     2  0,2,7,5,5,0,7,0,9,0,2,6*0,9,0,2,3,0,5,6,7,0,9,0,2,7*0/
C	DATA BTBL2/
C     3  4,8*0,2,0,6*2,0,3,3*0,7,7,3*0,4,4*0,5,3*0,5,0,7,5,0,5,0,5,0,
C     4  6,0,7,5,3*0,6,0,7,2,4*7,0,7,0,8,8*0,9,0,6*9,0/
C	DATA BTBL3/4,2,3,4,5,6,7,8,9,
C     5  9*2,3,2,3,3,3*7,3,9,4,2,3,4,5,5,7,4,9,5,2,7,3*5,7,5,9,
C     6  6,2,7,5,5,6,7,6,9,7,2,6*7,9,8,2,3,4,5,6,7,8,9,9,2,7*9/
C	DATA BTBL4/
C     7  4,2,3,4,5,6,7,8,9,9*2,3,2,3,3,3*7,3,9,4,2,3,4,5,5,7,4,9,
C     8  5,2,7,5,5,5,7,5,9,6,2,7,5,5,6,7,6,9,7,2,6*7,9,8,2,3,4,5,6,7,8,9,
C     9  9,2,7*9/
C	DATA BTBL5/4,2,3,6*4,9*0,9*0,9*0,0,9,6*0,9,0,9,6*0,9,0,9,6*0,9,
C     1  9*0,9*0/
C	DATA BTBL6/4,3*0,3*9,4,0,4,3*0,3*9,0,0,4,3*0,3*9,2*0,4,3*0,3*9,
C     2  2*0,4,3*0,3*4,2*0,4,3*0,3*4,2*0,4,3*0,3*4,2*0,4,3*0,3*9,2*0,
C     3  4,3*0,3*9,2*0/
C        DATA BTBL7/4,2,3,6*4,9*2,9*3,9*4,5,9,6*5,9,6,9,6,6,5,6,7,6,9,
C     4  7,9,6*7,9,9*8,9*9/
C	DATA BTBL8/4,1,4,4,3,3,3,4,3,2,1,2,2,3*1,2,1,4,3,4,4,3*3,
C     5  4,3,4,3,4,4,3*3,4,3,6,1,6*6,1,5,1,6*5,1,7,1,6*7,1,4,3,4,4,3*3,
C     6  4,3,2,1,2,2,3*1,2,1/
C
C HERE COPY LOCAL DATA INTO THE COMMONS.
C SINCE MOST ARRAYS AND THINGS ARE SMALL, WE JUST DO IT WITH REGULAR FORTRAN.
C THE BTBL ARRAY IS HANDLED IN WRKFIL WHERE THERE'S A BIG ENOUGH ARRAY FOR
C SCRATCH SPACE TO HOLD THE INITIAL DATA; WRKFIL IS CALLED BY WSSET WITH
C "SECRET CODE" TO INIT DTBL1 FROM THE ARRAY AND DOES SO ONCE ONLY.
	VIEWSW=0
	LEVEL=1
	LASTOP=0
	BASED=10
	COMMA=BOMMA
	BLANK=BBLANK
	RPAR=BRPAR
	LPAR=BLPAR
	EQ=BEQ
	DO 1 N=1,6
	ITCNTV(N)=0
1	CONTINUE
	DO 2 N=1,27
	DO 12 NN=1,20
12	AVBLS(NN,N)=0
2	ALPHA(N)=BLPHA(N)
	ST1LIM=40
	ST2LIM=40
C THIS IS DONE IN WRKFIL SINCE THERE'S A BIG LOCAL ARRAY THERE
C WE CAN KEEP EQUIVALENCED TO THIS ONE...
C	DO 3 N2=1,9
C	DO 3 N1=1,9
C	DTBL1(N1,N2,2)=BTBL2(N1,N2)
C	DTBL1(N1,N2,3)=BTBL3(N1,N2)
C	DTBL1(N1,N2,4)=BTBL4(N1,N2)
C	DTBL1(N1,N2,5)=BTBL5(N1,N2)
C	DTBL1(N1,N2,6)=BTBL6(N1,N2)
C	DTBL1(N1,N2,7)=BTBL7(N1,N2)
C	DTBL1(N1,N2,8)=BTBL8(N1,N2)
C3	DTBL1(N1,N2,1)=BTBL1(N1,N2)
	DO 4 N=1,9
	VLEN(N)=BVLEN(N)
4	CONTINUE
	DO 5 N2=1,3
	DO 5 N1=1,16
	DIGITS(N1,N2)=BIGITS(N1,N2)
5	CONTINUE
C SET UP DEFAULT DISPLAY FORMAT (INCLUDES "(" AND ")" CHARS WHICH
C ***MUST*** BE THERE FOR MAIN PGM TO WORK).
	DO 17 N=1,12
	DVFMT(N)=BVFMT(N)
17	Continue
d	ill=loc(bvfmt(1))
d	write(*,9210) (bvfmt(n),n=1,12),ill
d	ill=loc(dvfmt(1))
d	write(*,9210) (dvfmt(n),n=1,12),ill
d9210   Format(' Bvfmt at init=',12A1,': addr=',i12)
	DO 15 N=1,26
	QAC(N)=0.
15	CONTINUE
	DO 18 N=1,8
	QDERIV(N)=1.
	ACV(N)=0
	QDEL(N)=0.
	QCENT(N)=0
18	CONTINUE
	QOLDVV=1.
	QCAC=1
	OSWIT=0
	OCNTR=0
	ILNFG=0
	ILNCT=0
	IC1POS=0
	IC2POS=0
	RETURN
	END
c -h- dtrcmd.for	Fri Aug 22 13:04:33 1986	
C DATATRIEVE INTERFACE FUNCTIONS
C NON-DATATRIEVE PARTS, FOR MSDOS VERSION
C
C THIS IS THE NON-DTR VERSION with dummy entry points for
C the DTR functions BUT supplying the new non-DTR functions
c completely.
	SUBROUTINE DTRCMD(LINE)
	CHARACTER*1 LINE(80)
	CHARACTER*62 LINEC
C	EQUIVALENCE(LINEC(1:1),LINE(1))
C	INCLUDE 'VKLUGPRM.FTN'
C COPYRIGHT (C) 1983 GLENN EVERHART
	INTEGER RETCD
C
C DEFINE FILE AREAS FOR MAPPING FILES...
C ONE INPUT FILE, TO BE ACCESSED AS A RANDOM ACCESS FILE OF 128 BYTE
C RECORDS OF DATA IF RANDOM, OR AS A FORMULA FILE IF SEQUENTIAL, AND
C ONE OUTPUT FILE TO BE WRITTEN THE SAME WAY. INPUT FILE CAN BE
C INPUT - ONLY OR READ/WRITE.
C
C DEFINE ALSO DATA STRUCTURES TO HOLD CELL RANGES (IN ROW AND COL)
C TO BE TREATED WITH THESE FILES, FLAG FOR HOW-OPEN, AND LUN USED.
C
C MFIOPN =	0	IF NOT OPEN
C		1	IF OPEN FOR READ ONLY, SEQUENTIAL
C		2	IF OPEN READ ONLY, RANDOM
C		3	IF OPEN READ/WRITE, RANDOM.
C
C MFOOPN =	0	IF NOT OPEN
C		1	IF OPEN WRITE SEQUENTIAL
C		2	IF OPEN WRITE RANDOM
C
C OTHER OPTIONS DON'T MAKE SENSE.
C MFIRL,MFIRH = RRW DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFICL,MFICH = RCL DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFORL,RH,MFOCL,CH = OUT FILE BOUNDS
C MFILUN,MFOLUN ARE LOGICAL UNITS.
	InTeGer*4 MFIOPN,MFIRL,MFIRH,MFICL,MFICH
	InTeGer*4 MFOOPN,MFORL,MFORH,MFOCL,MFOCH

	InTeGer*4 MFILUN,MFOLUN,MFIFLG,MFOFLG
	COMMON/MFILES/MFIOPN,MFOOPN,MFIRL,MFIRH,MFICL,MFICH,
     1  MFORL,MFORH,MFOCL,MFOCH,MFILUN,MFOLUN,MFIFLG,MFOFLG
C
C
	CHARACTER*1 AVBLS(20,27),WRK(128),VBLS(8,1,1)
	InTeGer*4 TYPE(1,1),VLEN(9)
	REAL*8 XAC,XVBLS(1,1)
	REAL*8 TAC,UAC,VAC,WAC,YAC
	REAL*8 TMP
	INTEGER*4 JVBLS(2,1,1)
	EQUIVALENCE(WAC,AVBLS(1,23)),(YAC,AVBLS(1,25))
	EQUIVALENCE(XAC,AVBLS(1,27))
	EQUIVALENCE(TAC,AVBLS(1,20))
	EQUIVALENCE(UAC,AVBLS(1,21))
	EQUIVALENCE(VAC,AVBLS(1,22))
	EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1))
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
CCC	InTeGer*4 XTNCNT,XTCFG,IPSET
CCC	CHARACTER*1 XTNCMD(80)
C ***<<<< RDD COMMON START >>>***
	InTeGer*4 RRWACT,RCLACT
C	COMMON/RCLACT/RRWACT,RCLACT
	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8
C	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
C     1  IDOL7,IDOL8
	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
C	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
C	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	InTeGer*4 KLVL
C	COMMON/KLVL/KLVL
	InTeGer*4 IOLVL,IGOLD
C	COMMON/IOLVL/IOLVL
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
     2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
C ***<<< RDD COMMON END >>>***
CCC	InTeGer*4 IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
CCC	COMMON/DOLLR/IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
CCC	InTeGer*4 RRWACT,RCLACT
CCC	COMMON/RCLACT/RRWACT,RCLACT
C ***<<< XVXTCD COMMON START >>>***
	CHARACTER*1 OARRY(100)
	InTeGer*4 OSWIT,OCNTR
C	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTeGer*4 IPS1,IPS2,MODFLG
C	COMMON/ICPOS/IPS1,IPS2,MODFLG
   	InTeGer*4 XTCFG,IPSET,XTNCNT
   	CHARACTER*1 XTNCMD(80)
C   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
	INTEGER KALKIT
C	COMMON/VARYIT/KALKIT
	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
	InTeGer*4 RCMODE,IRCE1,IRCE2
C	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
C     1  IRCE2
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
C RCFGX ON.
C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
C  AND VM INHIBITS. (SETS TO 1).
	INTEGER*4 FH
C FILE HANDLE FOR CONSOLE I/O (RAW)
C	COMMON/CONSFH/FH
	CHARACTER*1 ARGSTR(52,4)
C	COMMON/ARGSTR/ARGSTR
	COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IPS1,IPS2,MODFLG,
     1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
     2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
     3  IRCE2,FH,ARGSTR
C ***<<< XVXTCD COMMON END >>>***
CCC	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
CCC	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE
CCC	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C LOOP CONTROL FOR VARY FUNCTION. SET ZERO IN SPREDSHT AND
C MUST BE SET POSITIVE HERE IF WE NEED ITERATIONS.
C (IMPLEMENT FOR VAX ONLY)
CCC	INTEGER KALKIT
CCC	COMMON/VARYIT/KALKIT
C ARGUMENTS COME IN IN ARGUMENTS IN LINE
C RESULTS GO INTO PERCENT (XAC) AND WHEREVER ELSE DESIRED...
CCC	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
CCC	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(20,75),NCDSP(20,75)
	COMMON/D2R/NRDSP,NCDSP
C ***<<< KLSTO COMMON START >>>***
	InTeGer*4 DLFG
C	COMMON/DLFG/DLFG
	InTeGer*4 KDRW,KDCL
C	COMMON/DOT/KDRW,KDCL
	InTeGer*4 DTRENA
C	COMMON/DTRCMN/DTRENA
	REAL*8 EP,PV,FV
	DIMENSION EP(20)
	INTEGER*4 KIRR
C	COMMON/ERNPER/EP,PV,FV,KIRR
	InTeGer*4 LASTOP
C	COMMON/ERROR/LASTOP
	CHARACTER*1 FMTDAT(9,76)
C	COMMON/FMTBFR/FMTDAT
	CHARACTER*1 EDNAM(16)
C	COMMON/EDNAM/EDNAM
	InTeGer*4 MFID(2),MFMOD(2)
C	COMMON/FRM/MFID,MFMOD
	InTeGer*4 JMVFG,JMVOLD
C	COMMON/FUBAR/JMVFG,JMVOLD
	COMMON/KLSTO/DLFG,KDRW,KDCL,DTRENA,EP,PV,FV,KIRR,
     1  LASTOP,FMTDAT,EDNAM,MFID,MFMOD,JMVFG,JMVOLD
C ***<<< KLSTO COMMON END >>>***
CCC	InTeGer*4 DTRENA
CCC	COMMON/DTRCMN/DTRENA
	CHARACTER *1 LINECL(82)
C	CHARACTER*70 LINEC
	EQUIVALENCE(LINEC(1:1),LINECL(1))
C	CHARACTER*80 SCRBUF
	CHARACTER*1 LBUF(128)
	CHARACTER*1 MBUF(128)
	CHARACTER*110 CLBUF,CMBUF
	CHARACTER*50 CCLBUF,CCMBUF
	CHARACTER*11 C11LBF
C	EQUIVALENCE(C11LBF(1:1),CLBUF(1:1))
	EQUIVALENCE(CLBUF(1:1),CCLBUF(1:1),LBUF(1),C11LBF(1:1)),
     1  (CMBUF(1:1),CCMBUF(1:1),MBUF(1))
C	EQUIVALENCE(CLBUF,LBUF(1)),(CMBUF,MBUF(1))
C USE CLBUF, CMBUF FOR CHARACTER COMPARISONS...
	CHARACTER*9 FMTB
	EQUIVALENCE (FMTB(1:1),LBUF(120))
	CHARACTER*11 FMTBF
	CHARACTER*1 IFVLD
C NULL OUT ANY TRAILING BLANKS ON COMMAND LINE
ccc	DO 3332 N=1,80
ccc	NN=81-N
ccc	IF(ICHAR(LINE(NN)).GT.32)GOTO 3333
ccc	LINE(NN)=CHAR(0)
ccc3332	CONTINUE
ccc3333	CONTINUE
C SPACE FILL ENTIRE ARRAY
	DO 3334 N=1,82
3334	LINECL(N)=CHAR(32)
	RETCD=1
C HANDLE DTRCMD FUNCTIONS. LINE ARRAY PASSED IN HERE
C STARTS AFTER THE "DTR" SO WE CAN DECODE IT.
C EXECUTE DTR COMMAND
C  DTRCMD (COMMAND) GIVES DTR COMMAND FACILITY AT COMMAND
C LEVEL.
C ALLOW DTRIMM COMMAND TO USE DTR IMMEDIATE TERMINAL
C INTERFACE. THE REST CAN USE SAME COMMAND NAMES AS AFTER
C THE "DB" IN *U DBXXXX COMMANDS.
500	CONTINUE
C ENABLE/DISABLE FOR DTR FUNCTIONS
C SETTING DTRENA TO -1 IMPLIES DISABLE FUNCTIONS
	CALL SCMP(LINE,'ENA',3,ICODE)
	IF(ICODE.NE.1)GOTO 600
	DTRENA=1
	GOTO 9999
600	CONTINUE
	CALL SCMP(LINE,'DIS',3,ICODE)
	IF(ICODE.NE.1)GOTO 700
	DTRENA=-1
	GOTO 9999
700	CONTINUE
	CALL SCMP(LINE,'OPINS',5,ICODE)
C OPEN INPUT SEQUENTIAL
	IF(ICODE.NE.1)GOTO 3800
C DTROPINS RANGE FILENAME
	IBGN=6
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFIRL,MFICL,MFIRH,MFICH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	LINE(LSTCH+25)=CHAR(0)
	OPEN(UNIT=MFILUN,FILE=LINE(LSTCH),ACCESS='SEQUENTIAL',
     1  STATUS='OLD',IOSTAT=IVVV)
	IF(IVVV.NE.0)GOTO 9990
	MFIOPN=1
	GOTO 9999
3800	CONTINUE
	CALL SCMP(LINE,'OPINRR',6,ICODE)
C OPEN IN RANDOM READ
	IF(ICODE.NE.1)GOTO 3900
	KK=2
	GOTO 3910
3900	CONTINUE
	CALL SCMP(LINE,'OPINRU',6,ICODE)
C OPEN IN RANDOM UPDATE
	IF(ICODE.NE.1)GOTO 3950
	KK=3
3910	CONTINUE
C HANDLE INPUT DIRECT ACCESS OPEN COMMONLY FOR READ ONLY AND R/W
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFIRL,MFICL,MFIRH,MFICH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C *******
C NEED HERE TO MOVE NAME INTO CHAR ARRAY...
	DO 5601 NN=1,50
5601	MBUF(NN)=' '
	DO 5602 NN=1,25
5602	MBUF(NN)=LINE(LSTCH+NN-1)
C	LINE(LSTCH+25)=0
C	NBK=(MFIRH-MFIRL+1)*(MFICH-MFICL+1)
C	OPEN(UNIT=MFILUN,FILE=CCMBUF,ACCESS='BINARY',
C     1  INITIALSIZE=NBK,FORM='UNFORMATTED',STATUS='OLD',
C     1  RECL=128,BLOCKSIZE=128,ERR=9990)
	OPEN(UNIT=MFILUN,FILE=CCMBUF(1:49),ACCESS='DIRECT',
     1  STATUS='OLD',FORM='UNFORMATTED',RECL=128,
     1  IOSTAT=IVVV)
	IF(IVVV.NE.0)GOTO 9990
	MFIOPN=KK
	GOTO 9999
3950	CONTINUE
	CALL SCMP(LINE,'OPOUTS',6,ICODE)
C OPEN OUTPUT SEQUENTIAL
	IF(ICODE.NE.1)GOTO 4000
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFORL,MFOCL,MFORH,MFOCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C *******
C NEED HERE TO MOVE NAME INTO CHAR ARRAY...
C	LINE(LSTCH+25)=0
	DO 5603 NN=1,50
5603	MBUF(NN)=' '
	DO 5604 NN=1,25
5604	MBUF(NN)=LINE(LSTCH+NN-1)
	OPEN(UNIT=MFOLUN,FILE=CCMBUF(1:49),ACCESS='SEQUENTIAL',
     1  STATUS='NEW',IOSTAT=IVVV)
	IF(IVVV.NE.0)GOTO 9990
	MFOOPN=1
	GOTO 9999
4000	CONTINUE
	CALL SCMP(LINE,'OPOUTR',6,ICODE)
C OPEN OUTPUT RANDOM
	IF(ICODE.NE.1)GOTO 4100
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFORL,MFOCL,MFORH,MFOCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C	NBK=(MFORH-MFORL+1)*(MFOCH-MFOCL+1)
C *******
C NEED HERE TO MOVE NAME INTO CHAR ARRAY...
	DO 5605 NN=1,50
5605	MBUF(NN)=' '
	DO 5606 NN=1,25
5606	MBUF(NN)=LINE(LSTCH+NN-1)
C	LINE(LSTCH+25)=0
C	OPEN(UNIT=MFOLUN,FILE=CCMBUF(1:49),ACCESS='DIRECT',
C     1  INITIALSIZE=NBK,FORM='UNFORMATTED',STATUS='NEW',
C     1  RECL=32,BLOCKSIZE=128,ERR=9990)
	OPEN(UNIT=MFOLUN,FILE=CCMBUF,ACCESS='DIRECT',
     1  STATUS='NEW',FORM='UNFORMATTED',RECL=128,
     2  IOSTAT=IVVV)
	IF(IVVV.NE.0)GOTO 9990
	MFOOPN=2
	GOTO 9999
4100	CONTINUE
	CALL SCMP(LINE,'CLSOUT',6,ICODE)
C CLOSE OUTPUT 
	IF(ICODE.NE.1)GOTO 4200
	CLOSE(UNIT=MFOLUN)
	MFOOPN=0
	GOTO 9999
4200	CONTINUE
	CALL SCMP(LINE,'CLSINP',6,ICODE)
C CLOSE INPUT 
	IF(ICODE.NE.1)GOTO 4300
	CLOSE(UNIT=MFILUN)
	MFIOPN=0
	GOTO 9999
4300	CONTINUE
	CALL SCMP(LINE,'ENAOUT',6,ICODE)
C ENABLE OUTPUT 
	IF(ICODE.NE.1)GOTO 4400
	MFOFLG=1
	GOTO 9999
4400	CONTINUE
	CALL SCMP(LINE,'ENAINP',6,ICODE)
C ENABLE INPUT 
	IF(ICODE.NE.1)GOTO 4500
	MFIFLG=1
	GOTO 9999
4500	CONTINUE
	CALL SCMP(LINE,'DISINP',6,ICODE)
C DISABLE INPUT 
	IF(ICODE.NE.1)GOTO 4510
	MFIFLG=0
	GOTO 9999
4510	CONTINUE
	CALL SCMP(LINE,'DISOUT',6,ICODE)
C DISABLE OUTPUT
	IF(ICODE.NE.1)GOTO 4520
	MFOFLG=0
	GOTO 9999
4520	CONTINUE
	CALL SCMP(LINE,'EDTINP',6,ICODE)
C ENABLE INPUT FORCE
C COMMAND
C DTREDTINP RANGE
C GETS RANGE, THEN FOR EACH CELL IN RANGE READS IN (BY WRKFIL READ CALL)
C A CELL, SETS ITS FVLD CODE TO -1 (TO FLAG A TEXT CELL), AND WRITES
C IT OUT AGAIN.
	IF(ICODE.NE.1)GOTO 4600
C FORCE ENABLE OF READIN DURING THIS
	MFIFLG=1
	MFOFLG=1
C ENABLE OUTPUT TOO.
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	DO 4550 N1=IXRL,IXRH
	DO 4550 N2=IXCL,IXCH
	CALL REFLEC(N2,N1,IRX)
C SET THE ELEMENT AS VALID AND READ/WRITE IT ONCE.
	CALL FVLDST(N1,N2,Char(255))
	CALL WRKFIL(IRX,LBUF,0)
	CALL WRKFIL(IRX,LBUF,1)
4550	CONTINUE
	MFIFLG=0
	MFOFLG=0
	GOTO 9999
4600	CONTINUE
	CALL SCMP(LINE,'FMTOUT',6,ICODE)
C FORMAT/WRITE OUTPUT
C COMMAND
C DTRFMTOUT RANGE
C GETS RANGE, THEN FOR EACH CELL IN RANGE READS IN (BY WRKFIL READ CALL)
C A CELL, SETS ITS FVLD CODE TO -1 (TO FLAG A TEXT CELL), AND WRITES
C IT OUT AGAIN.
	IF(ICODE.NE.1)GOTO 4630
	IVLFG=1
	GOTO 4740
4630	CONTINUE
	CALL SCMP(LINE,'VALOUT',6,ICODE)
	IF(ICODE.NE.1)GOTO 4700
C VALOUT CMD OUTPUTS VALUES WITH LONG D FORMAT
	IVFLG=2
C	GOTO 4740
4740	CONTINUE
C FORCE ENABLE OF READIN DURING THIS
	MFIFLG=1
	MFOFLG=1
C ENABLE OUTPUT TOO.
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	DO 4650 N1=IXRL,IXRH
	DO 4650 N2=IXCL,IXCH
C FIND INDEX FOR WRKFIL
	CALL REFLEC(N2,N1,IRX)
C SET THE ELEMENT AS VALID AND READ/WRITE IT ONCE.
	CALL XVBLGT(N1,N2,TMP)
C TMP IS REAL*8 SCRATCH
	CALL FVLDST(N1,N2,Char(255))
	CALL WRKFIL(IRX,LBUF,0)
C HAVING LOADED THE RECORD NOW (GETTING FORMAT, ETC.)
C NOW GRAB THE VALUE AND SAVE IT...
C FIRST MOVE THE FORMAT DOWN
C NOTE LINEC AND LINECL ARE EQUIVALENT BUT LINECL IS CHAR*1
	DO 4651 N=1,9
	LBUF(N+1)=LBUF(N+119)
4651	CONTINUE
	LBUF(1)='('
	LBUF(11)=')'
c	LBUF(12)=CHAR(0)
C CHANGE TO USE CHAR VERSION OF LBUF
C *******
C FORMAT NOW LIVES IN LOW PART OF LBUF
C D25.17 FORMAT WOULD DO FOR WRITE
c	IF(IVLFG.EQ.1)WRITE(LINEC(1:70),C11LBF(1:11),ERR=4652)TMP
	IF(IVLFG.EQ.1)WRITE(LINEC(1:70),C11LBF,ERR=4652)TMP
	IF(IVLFG.EQ.2)WRITE(LINEC(1:70),4658,ERR=4652)TMP
4658	FORMAT(D25.17)
C USE BUILTIN FORMAT TO WRITE THE VALUE IF COMMANDED TO DO SO OR
C USE DISPLAY FORMAT.
4652	CONTINUE
	KK=1
	DO 4653 N=1,110
4653	LBUF(N)=CHAR(0)
	DO 4654 N=1,60
C COPY LINECL CHARS TO LBUF, SKIPPING SPACES
	KKK=JCHAR(LINECL(N))
	IF(KKK.LE.32)GOTO 4654
	LBUF(KK)=LINECL(N)
	KK=KK+1
4654	CONTINUE
	CALL WRKFIL(IRX,LBUF,1)
4650	CONTINUE
	MFIFLG=0
	MFOFLG=0
	GOTO 9999
4700	CONTINUE
	CALL SCMP(LINE,'CMPFRM',6,ICODE)
	IF(ICODE.NE.1)GOTO 4800
C DBCMPFRM V1:V2
C RETURNS IN % THE INDEX OF FORMULA 1 IN FORMULA 2
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C IF WE HAVE A COMMA AND ANOTHER MTX USE IT AS LENGTHS
	CALL REFLEC(IXCL,IXRL,IRXL)
	CALL REFLEC(IXCH,IXRH,IRXH)
	IF(LINE(LSTCH).NE.',')GOTO 4780
	IBGN=LSTCH+1
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IYRL,IYCL,IYRH,IYCH,IVLD)
	IF(IVLD.EQ.3)GOTO 4780
C GET THE LENGTHS NOW
	CALL XVBLGT(IYRL,IYCL,TMP)
	IF(TMP.LT.1.OR.TMP.GT.109.)GOTO 4780
	LBUFL=TMP
	CALL XVBLGT(IYRH,IYCH,TMP)
	IF(TMP.LT.1.OR.TMP.GT.109.)GOTO 4780
	MBUFL=TMP
C IF LENGTHS ARE OK FOR BOTH, THEN USE THEM AND DO THE
C COMPARISONS BASED ON THAT.
	GOTO 4770
4780	CONTINUE
C GET INDEX OF EACH ELEMENT...
	CALL WRKFIL(IRXL,LBUF,0)
	CALL WRKFIL(IRXH,MBUF,0)
C LOAD THE 2 FORMULAS.
C NOW FIND THE ENDS...
	DO 4750 N=1,110
	NN=111-N
	IF(JCHAR(LBUF(NN)).GT.32)GOTO 4751
4750	CONTINUE
4751	LBUFL=NN
	DO 4760 N=1,110
	NN=111-N
	IF(JCHAR(MBUF(NN)).GT.32)GOTO 4761
4760	CONTINUE
4761	MBUFL=NN
4770	CONTINUE
c find index pos'n by hand...
	KK=LBUFL-MBUFL+1
	DO 4776 NN=1,KK
	IF(LBUF(NN).NE.MBUF(1))GOTO 4776
	NNN=MBUFL-1
	DO 4777 N=1,NNN
	IVVV=NN+N
	IF (LBUF(IVVV).NE.MBUF(N+1))GOTO 4778
4777	CONTINUE
C IF WE GALL THRU HERE ANYTIME WE HAVE A MATCH.
C SINCE NN IS WHAT WE NEED, GO USE IT.
	GOTO 4779
4778	CONTINUE
4776	CONTINUE
C IF NO MATCH, SET NN=0 TO SO FLAG IT AND BUG OUT.
C
	NN=0
4779	CONTINUE
C NN IS LOCATION OF SUBSTRING NOW
C	NN=INDEX(CLBUF(1:LBUFL),CMBUF(1:MBUFL))
C NN IS LOCATION OF SUBSTRING NOW
	XAC=NN
C RETURN RESULT IN % ACCUMULATOR.
	WAC=0.
	IF(LLT(CLBUF(1:LBUFL),CMBUF(1:MBUFL)))WAC=-1.
	IF(LGT(CLBUF(1:LBUFL),CMBUF(1:MBUFL)))WAC=1.
C RETURN LESS/GREATER/EQUAL IN W ACCUMULATOR FOR POSSIBLE
C USE IN SORTS, ETC. THUS WE CAN TEST 2 STRINGS BY TESTING W ACCUM.
C (LEAVES X, Y ALONE SINCE W IS MORE FREQUENTLY FREE.)
	GOTO 9999
4800	CONTINUE
	CALL SCMP(LINE,'LENFRM',6,ICODE)
	IF(ICODE.NE.1)GOTO 4900
C DBLENFRM V1:V2
C RETURNS LENGTH OF FORMULA IN V1 IN % AND V2
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C IF WE HAVE A COMMA AND ANOTHER MTX USE IT AS LENGTHS
	CALL REFLEC(IXCL,IXRL,IRXL)
C GET INDEX OF EACH ELEMENT...
	CALL WRKFIL(IRXL,LBUF,0)
C LOAD THE FORMULA.
C NOW FIND THE END...
	DO 4850 N=1,110
	NN=111-N
	IF(JCHAR(LBUF(NN)).GT.32)GOTO 4851
4850	CONTINUE
4851	LBUFL=NN
	TMP=LBUFL
	XAC=TMP
C SAVE LENGTH IN OUTPUT CELL. DON'T TOUCH VALIDITY FOR THE CELL.
	NN=0
C SEE IF CELL IS VALID AND IF NOT VALID DON'T SAVE ANYTHING IN IT.
	CALL FVLDGT(IXRH,IXCH,NN)
	IF(NN.EQ.0)GOTO 9999
	CALL XVBLST(IXRH,IXCH,TMP)
	GOTO 9999
4900	CONTINUE
	CALL SCMP(LINE,'TRMFRM',6,ICODE)
	IF(ICODE.NE.1)GOTO 5000
C TRIM FORMULA
C DTRTRMFRM INCELL:OUTCELL,START:END
C RETURNS TRIMMED FORMULA TO CELL.
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCHR,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C GOT CELL HERE...BOTH FOR INPUT AND OUTPUT
	CALL REFLEC(IXCL,IXRL,IRXL)
C GET INDEX OF EACH ELEMENT...
	CALL REFLEC(IXCH,IXRH,IRXH)
	CALL WRKFIL(IRXL,LBUF,0)
	LO=LSTCHR+1
	LHI=LSTCHR+21
	LSTCHR=LHI
	CALL VARSCN(LINE,LO,LHI,LSTCHR,JD1,JD2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
	CALL XVBLGT(JD1,JD2,TMP)
	LOCHR=1
	IF(TMP.GT.0..AND.TMP.LT.110.)LOCHR=TMP
C LOCHR = START CHAR
	LO=LSTCHR+1
	LHI=LSTCHR+21
	LSTCHR=LHI
	CALL VARSCN(LINE,LO,LHI,LSTCHR,JD1,JD2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
	CALL XVBLGT(JD1,JD2,TMP)
	LHICHR=110
	IF(TMP.GT.0..AND.TMP.LT.110.)LHICHR=TMP
C LHICHR IS END CHARACTER
C NOW ALL ARGS ARE COLLECTED.
C (IGNORE WHAT WAS DELIMITER...)
C COPY DESIRED STUFF TO MBUF
	N=1
	DO 4910 NN=1,110
	MBUF(NN)=CHAR(0)
	IF(NN.LT.LOCHR.OR.NN.GT.LHICHR)GOTO 4910
	MBUF(N)=LBUF(NN)
	N=N+1
C COPY DESIRED PART OF FORMULA TO MBUF WITH THE REST ZEROED.
4910	CONTINUE
	DO 4911 NN=111,128
4911	MBUF(NN)=LBUF(NN)
	CALL WRKFIL(IRXH,MBUF,1)
C WRITE BUFFER BACK TO CELL AS TRIMMED NOW, GOING TO OUT CELL
C RATHER THAN INPUT CELL (TO ALLOW REPEATED CALCS TO BE STABLE.)
	GOTO 9999
5000	CONTINUE
	GOTO 9999
9990	RETCD=3
C ERROR RETURN
9999	RETURN
	END
c -h- dtrfct.for	Fri Aug 22 13:05:02 1986	
C DATATRIEVE INTERFACE FUNCTIONS
C NON-DATATRIEVE PARTS, FOR MSDOS VERSION
C COPYRIGHT 1986 GCE
	SUBROUTINE DTRFCT(LINE,RETCD)
	InTeGer*4 RETCD
	CHARACTER*1 LINE(80)
	CHARACTER *1 LINECL(82)
	CHARACTER*62 LINEC
	EQUIVALENCE(LINEC(1:1),LINECL(1))
C
C
C DEFINE FILE AREAS FOR MAPPING FILES...
C
C DEFINE ALSO DATA STRUCTURES TO HOLD CELL RANGES (IN ROW AND COL)
C TO BE TREATED WITH THESE FILES, FLAG FOR HOW-OPEN, AND LUN USED.
C
C MFIOPN =	0	IF NOT OPEN
C		1	IF OPEN FOR READ ONLY, SEQUENTIAL
C		2	IF OPEN READ ONLY, RANDOM
C		3	IF OPEN READ/WRITE, RANDOM.
C
C MFOOPN =	0	IF NOT OPEN
C		1	IF OPEN WRITE SEQUENTIAL
C		2	IF OPEN WRITE RANDOM
C
C OTHER OPTIONS DON'T MAKE SENSE.
C MFIRL,MFIRH = RRW DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFICL,MFICH = RCL DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFORL,RH,MFOCL,CH = OUT FILE BOUNDS
C MFILUN,MFOLUN ARE LOGICAL UNITS.
	InTeGer*4 MFIOPN,MFIRL,MFIRH,MFICL,MFICH
	InTeGer*4 MFOOPN,MFORL,MFORH,MFOCL,MFOCH
	InTeGer*4 MFILUN,MFOLUN,MFIFLG,MFOFLG
	COMMON/MFILES/MFIOPN,MFOOPN,MFIRL,MFIRH,MFICL,MFICH,
     1  MFORL,MFORH,MFOCL,MFOCH,MFILUN,MFOLUN,MFIFLG,MFOFLG
C
C
C	INCLUDE 'VKLUGPRM.FTN'
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
	CHARACTER*1 AVBLS(20,27),WRK(128),VBLS(8,1,1)
	InTeGer*4 TYPE(1,1),VLEN(9)
	REAL*8 XAC,XVBLS(1,1)
	REAL*8 TAC,UAC,VAC,WAC,YAC
	REAL*8 TMP
	INTEGER*4 JVBLS(2,1,1)
	EQUIVALENCE(WAC,AVBLS(1,23)),(YAC,AVBLS(1,25))
	EQUIVALENCE(XAC,AVBLS(1,27))
	EQUIVALENCE(TAC,AVBLS(1,20))
	EQUIVALENCE(UAC,AVBLS(1,21))
	EQUIVALENCE(VAC,AVBLS(1,22))
	EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1))
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
C ***<<<< RDD COMMON START >>>***
	InTeGer*4 RRWACT,RCLACT
C	COMMON/RCLACT/RRWACT,RCLACT
	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8
C	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
C     1  IDOL7,IDOL8
	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
C	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
C	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	InTeGer*4 KLVL
C	COMMON/KLVL/KLVL
	InTeGer*4 IOLVL,IGOLD
C	COMMON/IOLVL/IOLVL
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
     2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
C ***<<< RDD COMMON END >>>***
CCC	InTeGer*4 XTNCNT,XTCFG,IPSET
CCC	CHARACTER*1 XTNCMD(80)
CCC	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
CCC	InTeGer*4 IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
CCC	COMMON/DOLLR/IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
CCC	InTeGer*4 RRWACT,RCLACT
CCC	COMMON/RCLACT/RRWACT,RCLACT
C ***<<< XVXTCD COMMON START >>>***
	CHARACTER*1 OARRY(100)
	InTeGer*4 OSWIT,OCNTR
C	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTeGer*4 IPS1,IPS2,MODFLG
C	COMMON/ICPOS/IPS1,IPS2,MODFLG
   	InTeGer*4 XTCFG,IPSET,XTNCNT
   	CHARACTER*1 XTNCMD(80)
C   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
	INTEGER KALKIT
C	COMMON/VARYIT/KALKIT
	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
	InTeGer*4 RCMODE,IRCE1,IRCE2
C	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
C     1  IRCE2
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
C RCFGX ON.
C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
C  AND VM INHIBITS. (SETS TO 1).
	INTEGER*4 FH
C FILE HANDLE FOR CONSOLE I/O (RAW)
C	COMMON/CONSFH/FH
	CHARACTER*1 ARGSTR(52,4)
C	COMMON/ARGSTR/ARGSTR
	COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IPS1,IPS2,MODFLG,
     1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
     2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
     3  IRCE2,FH,ARGSTR
C ***<<< XVXTCD COMMON END >>>***
CCC	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE
CCC	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C LOOP CONTROL FOR VARY FUNCTION. SET ZERO IN SPREDSHT AND
C MUST BE SET POSITIVE HERE IF WE NEED ITERATIONS.
C (IMPLEMENT FOR VAX ONLY)
	INTEGER IVVV
CCC	COMMON/VARYIT/KALKIT
C ARGUMENTS COME IN IN ARGUMENTS IN LINE
C RESULTS GO INTO PERCENT (XAC) AND WHEREVER ELSE DESIRED...
CCC	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
CCC	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(20,75),NCDSP(20,75)
	COMMON/D2R/NRDSP,NCDSP
C ***<<< KLSTO COMMON START >>>***
	InTeGer*4 DLFG
C	COMMON/DLFG/DLFG
	InTeGer*4 KDRW,KDCL
C	COMMON/DOT/KDRW,KDCL
	InTeGer*4 DTRENA
C	COMMON/DTRCMN/DTRENA
	REAL*8 EP,PV,FV
	DIMENSION EP(20)
	INTEGER*4 KIRR
C	COMMON/ERNPER/EP,PV,FV,KIRR
	InTeGer*4 LASTOP
C	COMMON/ERROR/LASTOP
	CHARACTER*1 FMTDAT(9,76)
C	COMMON/FMTBFR/FMTDAT
	CHARACTER*1 EDNAM(16)
C	COMMON/EDNAM/EDNAM
	InTeGer*4 MFID(2),MFMOD(2)
C	COMMON/FRM/MFID,MFMOD
	InTeGer*4 JMVFG,JMVOLD
C	COMMON/FUBAR/JMVFG,JMVOLD
	COMMON/KLSTO/DLFG,KDRW,KDCL,DTRENA,EP,PV,FV,KIRR,
     1  LASTOP,FMTDAT,EDNAM,MFID,MFMOD,JMVFG,JMVOLD
C ***<<< KLSTO COMMON END >>>***
CCC	InTeGer*4 DTRENA
CCC	COMMON/DTRCMN/DTRENA
C	CHARACTER*70 LINEC
	CHARACTER*1 LBUF(128)
	CHARACTER*1 MBUF(128)
	CHARACTER*110 CLBUF,CMBUF
C	EQUIVALENCE(CLBUF(1:1),LBUF(1)),(CMBUF(1:1),MBUF(1))
	CHARACTER*50 CCMBUF
	CHARACTER*11 C11LBF
	EQUIVALENCE(CCMBUF(1:1),CMBUF(1:1),MBUF(1)),
     1  (C11LBF(1:1),CLBUF(1:1),LBUF(1))
C USE CLBUF, CMBUF FOR CHARACTER COMPARISONS...
c	CHARACTER*1 IFVLD
	RETCD=1
	IF(DTRENA.LT.0)GOTO 9999
C NULL OUT ANY TRAILING BLANKS ON COMMAND LINE
ccc	DO 3332 N=1,76
ccc	NN=77-N
ccc	IF(JCHAR(LINE(NN)).GT.32)GOTO 3333
ccc	LINE(NN)=CHAR(0)
ccc3332	CONTINUE
ccc3333	CONTINUE
C SPACE FILL ENTIRE ARRAY
	DO 3334 N=1,82
3334	LINECL(N)=CHAR(32)
	RETCD=1
C HANDLE *U DBXXXX FUNCTIONS. LINE ARRAY PASSED IN HERE
C STARTS AFTER THE "DB" SO WE CAN DECODE IT.
C *U DBCMD (COMMAND) PASSES COMMAND TO DTR FOR ACTION
C  HOWEVER THIS DOES NOT RETURN A VALUE. USE FOR
C  SETUP PURPOSES ONLY.
C
C NO NEED TO INCLUDE ABILITY TO STORE COMMANDS IN CELLS
C FOR EDITING SINCE {CELL CONSTRUCT PROVIDES THIS ALREADY.
C (AND AT COMMAND LEVEL THE __{CELL CONSTRUCT DOES ALSO.)
500	CONTINUE
	CALL SCMP(LINE,'OPINS',5,ICODE)
C OPEN INPUT SEQUENTIAL
	IF(ICODE.NE.1)GOTO 3800
C DTROPINS RANGE FILENAME
	IBGN=6
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFIRL,MFICL,MFIRH,MFICH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C	LINE(LSTCH+25)=CHAR(0)
	DO 5601 NN=1,50
5601	MBUF(NN)=' '
	DO 5602 NN=1,25
5602	MBUF(NN)=LINE(LSTCH+NN-1)
	OPEN(UNIT=MFILUN,FILE=CCMBUF,ACCESS='SEQUENTIAL',
     1  STATUS='OLD',IOSTAT=IVVV)
	IF(IVVV.NE.0)GOTO 9990
	MFIOPN=1
	GOTO 9999
3800	CONTINUE
	CALL SCMP(LINE,'OPINRR',6,ICODE)
C OPEN IN RANDOM READ
	IF(ICODE.NE.1)GOTO 3900
	KK=2
	GOTO 3910
3900	CONTINUE
	CALL SCMP(LINE,'OPINRU',6,ICODE)
C OPEN IN RANDOM UPDATE
	IF(ICODE.NE.1)GOTO 3950
	KK=3
3910	CONTINUE
C HANDLE INPUT DIRECT ACCESS OPEN COMMONLY FOR READ ONLY AND R/W

	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFIRL,MFICL,MFIRH,MFICH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C	LINE(LSTCH+25)=0
	DO 5603 NN=1,50
5603	MBUF(NN)=' '
	DO 5604 NN=1,25
5604	MBUF(NN)=LINE(LSTCH+NN-1)
C	NBK=(MFIRH-MFIRL+1)*(MFICH-MFICL+1)
	OPEN(MFILUN,FILE=CCMBUF(1:49),ACCESS='DIRECT',
     1  FORM='UNFORMATTED',RECL=128,STATUS='OLD',IOSTAT=IVVV)
	IF(IVVV.NE.0)GOTO 9990
	MFIOPN=KK
	GOTO 9999
3950	CONTINUE
	CALL SCMP(LINE,'OPOUTS',6,ICODE)
C OPEN OUTPUT SEQUENTIAL
	IF(ICODE.NE.1)GOTO 4000
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFORL,MFOCL,MFORH,MFOCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	DO 5605 NN=1,50
5605	MBUF(NN)=' '
	DO 5606 NN=1,25
5606	MBUF(NN)=LINE(LSTCH+NN-1)
	OPEN(UNIT=MFOLUN,FILE=CCMBUF,ACCESS='SEQUENTIAL',
     1  STATUS='NEW',IOSTAT=IVVV)
	IF(IVVV.NE.0)GOTO 9990
	MFOOPN=1
	GOTO 9999
4000	CONTINUE
	CALL SCMP(LINE,'OPOUTR',6,ICODE)
C OPEN OUTPUT RANDOM
	IF(ICODE.NE.1)GOTO 4100
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFORL,MFOCL,MFORH,MFOCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C	NBK=(MFORH-MFORL+1)*(MFOCH-MFOCL+1)
C	LINE(LSTCH+25)=0
	DO 5607 NN=1,50
5607	MBUF(NN)=' '
	DO 5608 NN=1,25
5608	MBUF(NN)=LINE(LSTCH+NN-1)
	OPEN(MFOLUN,FILE=CCMBUF(1:49),ACCESS='DIRECT',
     1  STATUS='NEW',FORM='UNFORMATTED',RECL=128,
     2  IOSTAT=IVVV)
	IF(IVVV.NE.0)GOTO 9990
	MFOOPN=2
	GOTO 9999
4100	CONTINUE
	CALL SCMP(LINE,'CLSOUT',6,ICODE)
C CLOSE OUTPUT 
	IF(ICODE.NE.1)GOTO 4200
	CLOSE(UNIT=MFOLUN)
	MFOOPN=0
	GOTO 9999
4200	CONTINUE
	CALL SCMP(LINE,'CLSINP',6,ICODE)
C CLOSE INPUT 
	IF(ICODE.NE.1)GOTO 4300
	CLOSE(UNIT=MFILUN)
	MFIOPN=0
	GOTO 9999
4300	CONTINUE
	CALL SCMP(LINE,'ENAOUT',6,ICODE)
C ENABLE OUTPUT 
	IF(ICODE.NE.1)GOTO 4400
	MFOFLG=1
	GOTO 9999
4400	CONTINUE
	CALL SCMP(LINE,'ENAINP',6,ICODE)
C ENABLE INPUT 
	IF(ICODE.NE.1)GOTO 4500
	MFIFLG=1
	GOTO 9999
4500	CONTINUE
	CALL SCMP(LINE,'DISINP',6,ICODE)
C DISABLE INPUT 
	IF(ICODE.NE.1)GOTO 4510
	MFIFLG=0
	GOTO 9999
4510	CONTINUE
	CALL SCMP(LINE,'DISOUT',6,ICODE)
C DISABLE OUTPUT
	IF(ICODE.NE.1)GOTO 4520
	MFOFLG=0
	GOTO 9999
4520	CONTINUE
	CALL SCMP(LINE,'EDTINP',6,ICODE)
C ENABLE INPUT FORCE
C COMMAND
C DTREDTINP RANGE
C GETS RANGE, THEN FOR EACH CELL IN RANGE READS IN (BY WRKFIL READ CALL)
C A CELL, SETS ITS FVLD CODE TO -1 (TO FLAG A TEXT CELL), AND WRITES
C IT OUT AGAIN.
	IF(ICODE.NE.1)GOTO 4600
C FORCE ENABLE OF READIN DURING THIS
	MFIFLG=1
	MFOFLG=1
C ENABLE OUTPUT TOO.
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	DO 4550 N1=IXRL,IXRH
	DO 4550 N2=IXCL,IXCH
	CALL REFLEC(N2,N1,IRX)
C SET THE ELEMENT AS VALID AND READ/WRITE IT ONCE.
	CALL FVLDST(N1,N2,Char(255))
	CALL WRKFIL(IRX,LBUF,0)
	CALL WRKFIL(IRX,LBUF,1)
4550	CONTINUE
	MFIFLG=0
	MFOFLG=0
	GOTO 9999
4600	CONTINUE
	CALL SCMP(LINE,'FMTOUT',6,ICODE)
C FORMAT/WRITE OUTPUT
C COMMAND
C DTRFMTOUT RANGE
C GETS RANGE, THEN FOR EACH CELL IN RANGE READS IN (BY WRKFIL READ CALL)
C A CELL, SETS ITS FVLD CODE TO -1 (TO FLAG A TEXT CELL), AND WRITES
C IT OUT AGAIN.
	IF(ICODE.NE.1)GOTO 4630
	IVLFG=1
	GOTO 4740
4630	CONTINUE
	CALL SCMP(LINE,'VALOUT',6,ICODE)
	IF(ICODE.NE.1)GOTO 4700
C VALOUT CMD OUTPUTS VALUES WITH LONG D FORMAT
	IVFLG=2
C	GOTO 4740
4740	CONTINUE
C FORCE ENABLE OF READIN DURING THIS
	MFIFLG=1
	MFOFLG=1
C ENABLE OUTPUT TOO.
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	DO 4650 N1=IXRL,IXRH
	DO 4650 N2=IXCL,IXCH
C FIND INDEX FOR WRKFIL
	CALL REFLEC(N2,N1,IRX)
C SET THE ELEMENT AS VALID AND READ/WRITE IT ONCE.
	CALL XVBLGT(N1,N2,TMP)
C TMP IS REAL*8 SCRATCH
	CALL FVLDST(N1,N2,Char(255))
	CALL WRKFIL(IRX,LBUF,0)
C HAVING LOADED THE RECORD NOW (GETTING FORMAT, ETC.)
C NOW GRAB THE VALUE AND SAVE IT...
C FIRST MOVE THE FORMAT DOWN
C NOTE LINEC AND LINECL ARE EQUIVALENT BUT LINECL IS CHAR*1
	DO 4651 N=1,9
	LBUF(N+1)=LBUF(N+119)
4651	CONTINUE
	LBUF(1)='('
	LBUF(11)=')'
c	LBUF(12)=0
C FORMAT NOW LIVES IN LOW PART OF LBUF
C D25.17 FORMAT WOULD DO FOR WRITE
C NEED CHAR VBL FOR FORMAT EQUIV'D TO LOW 12 CHARS OF LBUF
c	IF(IVLFG.EQ.1)WRITE(LINEC(1:62),C11LBF(1:11),ERR=4652)TMP
	IF(IVLFG.EQ.1)WRITE(LINEC(1:62),C11LBF,ERR=4652)TMP
	IF(IVLFG.EQ.2)WRITE(LINEC(1:62),4658,ERR=4652)TMP
4658	FORMAT(D25.17)
C USE BUILTIN FORMAT TO WRITE THE VALUE IF COMMANDED TO DO SO OR
C USE DISPLAY FORMAT.
4652	CONTINUE
	KK=1
	DO 4653 N=1,110
4653	LBUF(N)=CHAR(0)
	DO 4654 N=1,60
C COPY LINECL CHARS TO LBUF, SKIPPING SPACES
	KKK=JCHAR(LINECL(N))
	IF(KKK.LE.32)GOTO 4654
	LBUF(KK)=LINECL(N)
	KK=KK+1
4654	CONTINUE
	CALL WRKFIL(IRX,LBUF,1)
4650	CONTINUE
	MFIFLG=0
	MFOFLG=0
	GOTO 9999
4700	CONTINUE
	CALL SCMP(LINE,'CMPFRM',6,ICODE)
	IF(ICODE.NE.1)GOTO 4800
C DBCMPFRM V1:V2
C RETURNS IN % THE INDEX OF FORMULA 1 IN FORMULA 2
	IBGN=7
	IVLD=0
	LSTCH=78
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C IF WE HAVE A COMMA AND ANOTHER MTX USE IT AS LENGTHS
	CALL REFLEC(IXCL,IXRL,IRXL)
	CALL REFLEC(IXCH,IXRH,IRXH)
	IF(LINE(LSTCH).NE.',')GOTO 4780
	IBGN=LSTCH+1
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IYRL,IYCL,IYRH,IYCH,IVLD)
	IF(IVLD.EQ.3)GOTO 4780
C GET THE LENGTHS NOW
	CALL XVBLGT(IYRL,IYCL,TMP)
	IF(TMP.LT.1.OR.TMP.GT.109.)GOTO 4780
	LBUFL=TMP
	CALL XVBLGT(IYRH,IYCH,TMP)
	IF(TMP.LT.1.OR.TMP.GT.109.)GOTO 4780
	MBUFL=TMP
C IF LENGTHS ARE OK FOR BOTH, THEN USE THEM AND DO THE
C COMPARISONS BASED ON THAT.
	GOTO 4770
4780	CONTINUE
C GET INDEX OF EACH ELEMENT...
	CALL WRKFIL(IRXL,LBUF,0)
	CALL WRKFIL(IRXH,MBUF,0)
C LOAD THE 2 FORMULAS.
C NOW FIND THE ENDS...
	DO 4750 N=1,110
	NN=111-N
	IF(JCHAR(LBUF(NN)).GT.32)GOTO 4751
4750	CONTINUE
4751	LBUFL=NN
	DO 4760 N=1,110
	NN=111-N
	IF(JCHAR(MBUF(NN)).GT.32)GOTO 4761
4760	CONTINUE
4761	MBUFL=NN
4770	CONTINUE
c find index pos'n by hand...
	KK=LBUFL-MBUFL+1
	DO 4776 NN=1,KK
	IF(LBUF(NN).NE.MBUF(1))GOTO 4776
	NNN=MBUFL-1
	DO 4777 N=1,NNN
	IVVV=NN+N
	IF (LBUF(IVVV).NE.MBUF(N+1))GOTO 4778
4777	CONTINUE
C IF WE GALL THRU HERE ANYTIME WE HAVE A MATCH.
C SINCE NN IS WHAT WE NEED, GO USE IT.
	GOTO 4779
4778	CONTINUE
4776	CONTINUE
C IF NO MATCH, SET NN=0 TO SO FLAG IT AND BUG OUT.
C
	NN=0
4779	CONTINUE
C NN IS LOCATION OF SUBSTRING NOW
C	NN=INDEX(CLBUF(1:LBUFL),CMBUF(1:MBUFL))
	XAC=NN
C RETURN RESULT IN % ACCUMULATOR.
	WAC=0.
	IF(LLT(CLBUF(1:LBUFL),CMBUF(1:MBUFL)))WAC=-1.
	IF(LGT(CLBUF(1:LBUFL),CMBUF(1:MBUFL)))WAC=1.
C RETURN LESS/GREATER/EQUAL IN W ACCUMULATOR FOR POSSIBLE
C USE IN SORTS, ETC. THUS WE CAN TEST 2 STRINGS BY TESTING W ACCUM.
C (LEAVES X, Y ALONE SINCE W IS MORE FREQUENTLY FREE.)
	GOTO 9999
4800	CONTINUE
	CALL SCMP(LINE,'LENFRM',6,ICODE)
	IF(ICODE.NE.1)GOTO 4900
C DBLENFRM V1:V2
C RETURNS LENGTH OF FORMULA IN V1 IN % AND V2
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	CALL REFLEC(IXCL,IXRL,IRXL)
C GET INDEX OF EACH ELEMENT...
	CALL WRKFIL(IRXL,LBUF,0)
C LOAD THE FORMULA.
C NOW FIND THE END...
	DO 4850 N=1,110
	NN=111-N
	IF(JCHAR(LBUF(NN)).GT.32)GOTO 4851
4850	CONTINUE
4851	LBUFL=NN
	TMP=LBUFL
	XAC=TMP
C SAVE LENGTH IN OUTPUT CELL. DON'T TOUCH VALIDITY FOR THE CELL.
	NN=0
C SEE IF CELL IS VALID AND IF NOT VALID DON'T SAVE ANYTHING IN IT.
	CALL FVLDGT(IXRH,IXCH,NN)
	IF(NN.EQ.0)GOTO 9999
	CALL XVBLST(IXRH,IXCH,TMP)
	GOTO 9999
4900	CONTINUE
	CALL SCMP(LINE,'TRMFRM',6,ICODE)
	IF(ICODE.NE.1)GOTO 5000
C TRIM FORMULA
C DTRTRMFRM INCELL:OUTCELL,START:END
C RETURNS TRIMMED FORMULA TO CELL.
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCHR,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C GOT CELL HERE...BOTH FOR INPUT AND OUTPUT
	CALL REFLEC(IXCL,IXRL,IRXL)
C GET INDEX OF EACH ELEMENT...
	CALL REFLEC(IXCH,IXRH,IRXH)
	CALL WRKFIL(IRXL,LBUF,0)
	LO=LSTCHR+1
	LHI=LSTCHR+21
	LSTCHR=LHI
	CALL VARSCN(LINE,LO,LHI,LSTCHR,JD1,JD2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
	CALL XVBLGT(JD1,JD2,TMP)
	LOCHR=1
	IF(TMP.GT.0..AND.TMP.LT.110.)LOCHR=TMP
C LOCHR = START CHAR
	LO=LSTCHR+1
	LHI=LSTCHR+21
	LSTCHR=LHI
	CALL VARSCN(LINE,LO,LHI,LSTCHR,JD1,JD2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
	CALL XVBLGT(JD1,JD2,TMP)
	LHICHR=110
	IF(TMP.GT.0..AND.TMP.LT.110.)LHICHR=TMP
C LHICHR IS END CHARACTER
C NOW ALL ARGS ARE COLLECTED.
C (IGNORE WHAT WAS DELIMITER...)
C COPY DESIRED STUFF TO MBUF
	N=1
	DO 4910 NN=1,110
	MBUF(NN)=CHAR(0)
	IF(NN.LT.LOCHR.OR.NN.GT.LHICHR)GOTO 4910
	MBUF(N)=LBUF(NN)
	N=N+1
C COPY DESIRED PART OF FORMULA TO MBUF WITH THE REST ZEROED.
4910	CONTINUE
	DO 4911 NN=111,128
4911	MBUF(NN)=LBUF(NN)
	CALL WRKFIL(IRXH,MBUF,1)
C WRITE BUFFER BACK TO CELL AS TRIMMED NOW, GOING TO OUT CELL
C RATHER THAN INPUT CELL (TO ALLOW REPEATED CALCS TO BE STABLE.)
	GOTO 9999
5000	CONTINUE
	GOTO 9999
9990	RETCD=3
C ERROR RETURN
9999	RETURN
	END
c -h- fft.ftn	Fri Aug 22 13:08:56 1986	
C  
C-----------------------------------------------------------------------
C SUBROUTINE: FOUREA
C PERFORMS COOLEY-TUKEY FAST FOURIER TRANSFORM
C-----------------------------------------------------------------------
C  
      SUBROUTINE FOUREA(ID1,ID2,IC,IR,IVN,ISI)
C ID1,ID2 = COORDS OF FIRST CELL. IC AND IR ARE 0, OR 1
C ONLY ONE OF IC, IR MAY BE NONZERO. (FLAGS HORIZ/VERTICAL
C DATA AREA)
C  
C THE COOLEY-TUKEY FAST FOURIER TRANSFORM IN ANSI FORTRAN
C  
C DATA IS A ONE-DIMENSIONAL COMPLEX ARRAY WHOSE LENGTH, N, IS A
C POWER OF TWO.  ISI IS +1 FOR AN INVERSE TRANSFORM AND -1 FOR A
C FORWARD TRANSFORM.  TRANSFORM VALUES ARE RETURNED IN THE INPUT
C ARRAY, REPLACING THE INPUT.
C TRANSFORM(J)=SUM(DATA(I)*W**((I-1)*(J-1))), WHERE I AND J RUN
C FROM 1 TO N AND W = EXP (ISI*2*PI*SQRT(-1)/N).  PROGRAM ALSO
C COMPUTES INVERSE TRANSFORM, FOR WHICH THE DEFINING EXPRESSION
C IS INVTR(J)=(1/N)*SUM(DATA(I)*W**((I-1)*(J-1))).
C RUNNING TIME IS PROPORTIONAL TO N*LOG2(N), RATHER THAN TO THE
C CLASSICAL N**2.
C AFTER PROGRAM BY BRENNER, JUNE 1967. THIS IS A VERY SHORT VERSION
C OF THE FFT AND IS INTENDED MAINLY FOR DEMONSTRATION. PROGRAMS
C ARE AVAILABLE IN THIS COLLECTION WHICH RUN FASTER AND ARE NOT
C RESTRICTED TO POWERS OF 2 OR TO ONE-DIMENSIONAL ARRAYS.
C SEE -- IEEE TRANS AUDIO (JUNE 1967), SPECIAL ISSUE ON FFT.
C  
C ASSUMES THAT FIRST N/2 ELEMENTS ARE REAL, SECOND COMPLEX...
C STORES DATA THAT WAY ALSO...
C
C      COMPLEX DATA(1)
C      COMPLEX TEMP, W
C MAKE THIS A REAL FFT, NOT COMPLEX...
	REAL*8 DATA(1),TEMP,W,TEMP2,TEMPI,WI
	InTeGer*4 ID1,ID2,IC,IR,IRX,IRXX,IVN,N
C SET UP STMT FUNCTIONS...
	ID1F(K)=ID1+IC*(K-1)
	ID2F(K)=ID2+IR*(K-1)
	N=IVN
C  
C CHECK FOR POWER OF TWO UP TO 14
C  
C INITIALLY SAY ALL OK
      NN = 1
      DO 10 I=1,14
        M = I
        NN = NN*2
        IF (NN.EQ.N) GO TO 20
	IF(NN.GT.N)GOTO 11
  10  CONTINUE
11	CONTINUE
	N=NN/2
C USE NEXT SMALLER POWER OF 2 ARRAY...
C	RETURN
C HERE BEGINNETH ACTUAL WORK.
C SET UP DATA COORDS ON THE FLY. NORMALLY I,J RUN IN RANGE 1 TO N
C SO WHERE K=(I OR J) (I.E., ONE OF THE TWO) WE USE A RELATION
C ID1V=ID1+IC*(K-1) AND ID2V=ID2+IR*(K-1). WE USE STMT FUNCTIONS
C ID1F AND ID2F FOR THIS.
  20  CONTINUE
	NOV2=N/2
C  
C      PI = 4.*ATAN(1.)
	PI=3.14159265358979323846264
      FN = NOV2
C  
C THIS SECTION PUTS DATA IN BIT-REVERSED ORDER
C  
      J = 1
      DO 80 I=1,NOV2
C  
C AT THIS POINT, I AND J ARE A BIT REVERSED PAIR (EXCEPT FOR THE
C DISPLACEMENT OF +1)
C  
	IF(I.GE.J)GOTO 40
C  
C EXCHANGE DATA(I) WITH DATA(J) IF I.LT.J.
C  
 30	CONTINUE
C EXCHANGE DATA(J), DATA(I)
	CALL XVBLGT(ID1F(J),ID2F(J),TEMP)
	CALL XVBLGT(ID1F(I),ID2F(I),DATA(1))
	CALL XVBLST(ID1F(J),ID2F(J),DATA(1))
	CALL XVBLST(ID1F(I),ID2F(I),TEMP)
C FLIP BOTH REAL AND COMPLEX PARTS OF DATA
	CALL XVBLGT(ID1F(J+NOV2),ID2F(J+NOV2),TEMP)
	CALL XVBLGT(ID1F(I+NOV2),ID2F(I+NOV2),DATA(1))
	CALL XVBLST(ID1F(J+NOV2),ID2F(J+NOV2),DATA(1))
	CALL XVBLST(ID1F(I+NOV2),ID2F(I+NOV2),TEMP)
C  30    TEMP = DATA(J)
C        DATA(J) = DATA(I)
C        DATA(I) = TEMP
C  
C IMPLEMENT J=J+1, BIT-REVERSED COUNTER
C  
  40    M = NOV2/2
  50    IF (J.LE.M) GOTO 70
  60    J = J - M
        M = (M+1)/2
        GO TO 50
  70    J = J + M
  80  CONTINUE
C  
C NOW COMPUTE THE BUTTERFLIES
C  
      MMAX = 1
  90  IF (MMAX.GE.NOV2)GOTO 130
 100  ISTEP = 2*MMAX
      DO 120 M=1,MMAX
        THETA = PI*FLOAT(ISI*(M-1))/FLOAT(MMAX)
	 W = COS(THETA)
        WI = SIN(THETA)
C        W = CMPLX(COS(THETA),SIN(THETA))
        DO 110 I=M,NOV2,ISTEP
          J = I + MMAX
C GET REAL AND IMAG HALVES OF NUMBER...
	  CALL XVBLGT(ID1F(J),ID2F(J),TEMP)
	  CALL XVBLGT(ID1F(J+NOV2),ID2F(J+NOV2),TEMPI)
C DO COMPLEX MULTIPLICATION BY HAND TO AVOID LARGE RUNTIME SYSTEM
C ROUTINE INCLUSION.
	  TEMP2=W*TEMP-WI*TEMPI
	  TEMPI=WI*TEMP+W*TEMPI
	TEMP=TEMP2
C          TEMP = W*DATA(J)
C          DATA(J) = DATA(I) - TEMP
C          DATA(I) = DATA(I) + TEMP
	   CALL XVBLGT(ID1F(I),ID2F(I),DATA(1))
	   TEMP2=DATA(1)+TEMP
	   DATA(1)=DATA(1) - TEMP
	   CALL XVBLST(ID1F(J),ID2F(J),DATA(1))
	   CALL XVBLST(ID1F(I),ID2F(I),TEMP2)
C COMPLEX PART
	   CALL XVBLGT(ID1F(I+NOV2),ID2F(I+NOV2),DATA(1))
	   TEMP2=DATA(1)+TEMPI
	   DATA(1)=DATA(1) - TEMPI
	   CALL XVBLST(ID1F(J+NOV2),ID2F(J+NOV2),DATA(1))
	   CALL XVBLST(ID1F(I+NOV2),ID2F(I+NOV2),TEMP2)
 110    CONTINUE
 120  CONTINUE
      MMAX = ISTEP
      GO TO 90
  130  IF (ISI.LT.0) GOTO 160
C  
C FOR INV TRANS -- ISI=1 -- MULTIPLY OUTPUT BY 1/N
C  
 140  DO 150 I=1,N
C        DATA(I) = DATA(I)/FN
	CALL XVBLGT(ID1F(I),ID2F(I),TEMP)
	TEMP=TEMP/FN
	CALL XVBLST(ID1F(I),ID2F(I),TEMP)
 150  CONTINUE
 160  RETURN
      END
c -h- help.for	Fri Aug 22 13:20:10 1986	
	SUBROUTINE HELP(LVL)
C PRINT HELP INFO ON SCREEN USING FIRST 22 LINES. ASSUME XQTCMD INVALIDATES
C THE DISPLAY.
C COPYRIGHT (C) 1983 GLENN AND MARY EVERHART
	CHARACTER*1 FORM(128)
	CALL UVT100(18,0,0)
	CALL UVT100(11,2,0)
	CALL UVT100(1,1,1)
C COPYRIGHT (C) 1983 GLENN and MARY EVERHART
C All Rights Reserved
C
C NEW PC HELP FILE
C DESIGNED TO BE SMALLER THAN OLD VERSION. READS FILES OFF DISK
C BY SKIPPING N*24 LINES AND DISPLAYING 24 LINES, WHERE N=LVL
C ASSUME HELP FILE ON DISK LOGGED CURRENTLY
	CLOSE(3)
c for now, assume help file lives on same disk as our default.
	IXXX=0
	OPEN(3,FILE='PCCHELP.HLP',STATUS='OLD',ACCESS='DIRECT',
     1  FORM='UNFORMATTED',RECL=128,IOSTAT=IXXX)
	IF(IXXX.GT.0)RETURN
C RETURN IF HELP FILE IS MISSING...
C USE A FIXED HELP FILE FOR MULTISCREEN HELP. LOWER OVERHEAD,...
	NSKP=LVL*24
C NOW READ IN THE DATA, WRITE TO SCREEN.
	KKL=NSKP+1
	KKH=NSKP+23
C JUST GO DIRECTLY TO THE DESIRED SCREENFUL OF INFO.
	DO 7640 KKK=KKL,KKH
	READ(3,REC=KKK,END=7642,ERR=7642)FORM
c use fortran writes here normally since we want the crlf stuff they imply
c always write 24 lines to scroll all else off...
	IVVV=78
C FIND END OF LINE AND ONLY EMIT CHARACTERS TO THAT; DON'T WASTE
C TIME DRAWING SPACES ON THE SCREEN.
	DO 772 IV=1,78
	IVVV=79-IV
	IF(ICHAR(FORM(IVVV)).GT.32)GOTO 773
772	CONTINUE
773	CONTINUE
	FORM(IVVV+1)=Char(13)
	FORM(IVVV+2)=Char(10)
	IVVV=IVVV+2
	CALL SWRT(FORM,IVVV)
C	WRITE(11,7643)(FORM(IV),IV=1,IVVV)
C NOTE WE HAVE LUN 6 OPENED AS CON: IN THE MAIN PROGRAM TO GIVE AN
C INDEPENDENT TERMINAL OUTPUT CHANNEL. HOPEFULLY THIS PREVENTS SOME
C SCREWUPS DUE TO USING LUN 0 FOR BOTH CONSOLE INPUT AND OUTPUT; END OF
C RECORDS OUGHT TO BE INDEPENDENT THIS WAY (I HOPE).
C7643	FORMAT(1X,82A1,4A1)
7640	CONTINUE
7642	CONTINUE
	CLOSE(3)
	FORM(1)=13
	CALL SWRT(FORM,1)
	RETURN
	END
c -h- linfit.for	Fri Aug 22 13:23:55 1986	
C LINE FITTING SUBROUTINE WITH ERROR MEASURE RETURN ALSO.
	SUBROUTINE LINFIT(ID1X,ID2X,IRCOL,ID1,ID2,N,A,B,DEL,RR)
	InTeGer*4 ID1X,ID2X,IRCOL,ID1,ID2,N
	REAL*8 A,B,DEL,XY,SX2,SX,SY,RR
	InTeGer*4 IC,IR,KK,KKK,I
	REAL*8 XI,YI,SY2,EN,WRK
C FIT LINE TO EQUALLY SPACED POINTS...
C Y=BX+A
	SY2=0.
	EN=N
	XY=0.
	SX2=0.
	SX=0.
	SY=0.
	IC=IRCOL
	IR=1-IRCOL
C IRCOL IS 0 OR 1 FOR ACROSS OR DOWN
	DO 10 I=1,N
C IF ID1X < 0 THEN FORM IT HERE AS ID1+I-1
	IF (ID1X.GT.0)GOTO 20
C FORM XI
	XI=I
	GOTO 30
20	CONTINUE
C INPUT XI
	KK=ID1X+IC*(I-1)
	KKK=ID2X+IR*(I-1)
	CALL XVBLGT(KK,KKK,XI)
30	CONTINUE
C GET YI IN ANY CASE...
	KK=ID1+IC*(I-1)
	KKK=ID2+IR*(I-1)
	CALL XVBLGT(KK,KKK,YI)
	XY=XY+XI*YI
C FORM SUMS NEEDED TO FIT LINE...
	SX2=SX2+XI*XI
	SX=SX+XI
	SY=SY+YI
	SY2=SY2+YI*YI
10	CONTINUE
C NOW GET SLOPE
	WRK=((XY-(SX*SY)/EN)/(SX2-(SX*SX)/EN))
	B=WRK
C THEN INTERCEPT
	WRK=(SY/EN)-B*(SX/EN)
	A=WRK
	WRK=DSQRT((SY2-(A*SY+B*XY))/EN)
	DEL=WRK
C DEL = ERROR OF FIT
	RR=(EN*XY-SX*SY)/DSQRT((EN*SX2-SX*SX)*(EN*SY2-SY*SY))
C RR IS CORRELATION COEFFICIENT
	RETURN
	END
c -h- list.for	Fri Aug 22 13:24:14 1986	
	SUBROUTINE LIST
C COPYRIGHT (C) 1983 GLENN EVERHART
C ALL RIGHTS RESERVED
C 60=MAX REAL ROWS
C 301=MAX REAL COLS
C 60 MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS
C VBLS AND TYPE DIMENSIONED 60,301
C **************************************************
C *                                                *
C *              SUBROUTINE  LIST                  *
C *                                                *
C **************************************************
C
C
C LISTS THE LEGAL CALC COMMANDS AND GIVES A BRIEF
C DESCRIPTION OF THEIR FUNCTION.
C
C LIST IS CALLED BY CALC
C
C	SUBROUTINE LIST
C
C
C NOTE WE USE FORTRAN WRITE HERE SINCE IT SHOULD ONLY HAPPEN IN CALC MODE.
	rewind 11
	WRITE (11,20)
	WRITE (11,30)
	rewind 11
	RETURN
20	FORMAT (' CMDS= @FILE-DO FILE;*C-COMMENT;*E-EXIT;*R-READ CON')
30	FORMAT (' *S-STOP;*V n(bet.0,3)-VIEW CTL- HIGHER=SEE MORE')
	END
c -h- wsset.f40	Fri Aug 22 13:43:11 1986	
        SUBROUTINE WSSET
C WORK SHEET MANAGMENT ROUTINES
C HANDLE SPREADSHEET "IN MEMORY" STORAGE
C COPYRIGHT (C) GLENN AND MARY EVERHART 1983,1984
C
C ALL RIGHTS RESERVED
C
C WSSET - INITIALIZE STORAGE TO START CONDITIONS
C EXPECT IMPLEMENTATION TO USE A COMMON BITMAP AND PROVIDE A VARIABLE
C NCEL TO TELL HOW MANY CELLS ARE IN USE
C NEXT BITMAPS IMPLEMENT FVLD
        CHARACTER*1 FV1(2264),FV2(2264),FV4(2264)
	CHARACTER*1 FVXX(6792)
	EQUIVALENCE (FV1(1),FVXX(1)),(FV2(1),FVXX(2265))
	EQUIVALENCE (FV4(1),FVXX(4529))
        Common/FVLDM/FVXX
c        COMMON/FVLDM/FV1,FV2,FV4
C THE FOLLOWING BITMAP IS FOR TYPE ARRAY, AND INTEGER ARRAY IS FOR
C TYPES OF AC'S STORAGE:
        CHARACTER*1 ITYP(2264)
        InTeGer*4 IATYP(27),LINTGR
        COMMON/TYP/IATYP,ITYP,LINTGR
        CHARACTER*1 LBITS(8)
        COMMON/BITS/LBITS
C ***<<<< RDD COMMON START >>>***
	InTeGer*4 RRWACT,RCLACT
C	COMMON/RCLACT/RRWACT,RCLACT
	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8
C	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
C     1  IDOL7,IDOL8
	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
C	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
C	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	InTeGer*4 KLVL
C	COMMON/KLVL/KLVL
	InTeGer*4 IOLVL,IGOLD
C	COMMON/IOLVL/IOLVL
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
     2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
C ***<<< RDD COMMON END >>>***
CCC        InTeGer*4 IPGMAX,LPGMXF
CCC        COMMON/FILEMX/IPGMAX,LPGMXF
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C USE LUN 7 FOR FORMULAS, 9 FOR VALUES FILE IF NEEDED...
C
C NEXT ARE BUFFERS FOR HOLDING VALUES, AND MEMORY OCCUPANCY WORDS
C FOR EACH GIVING THE BLK # IN USE FOR THESE TABLES
C FORMAT BLOCK (ONE ONLY, 512 BYTES, BUT ORGANIZED AS 76 FORMAT
C AREAS WITH DATA.
C ***<<< KLSTO COMMON START >>>***
	InTeGer*4 DLFG
C	COMMON/DLFG/DLFG
	InTeGer*4 KDRW,KDCL
C	COMMON/DOT/KDRW,KDCL
	InTeGer*4 DTRENA
C	COMMON/DTRCMN/DTRENA
	REAL*8 EP,PV,FV
	DIMENSION EP(20)
	INTEGER*4 KIRR
C	COMMON/ERNPER/EP,PV,FV,KIRR
	InTeGer*4 LASTOP
C	COMMON/ERROR/LASTOP
	CHARACTER*1 FMTDAT(9,76)
C	COMMON/FMTBFR/FMTDAT
	CHARACTER*1 EDNAM(16)
C	COMMON/EDNAM/EDNAM
	InTeGer*4 MFID(2),MFMOD(2)
C	COMMON/FRM/MFID,MFMOD
	InTeGer*4 JMVFG,JMVOLD
C	COMMON/FUBAR/JMVFG,JMVOLD
	COMMON/KLSTO/DLFG,KDRW,KDCL,DTRENA,EP,PV,FV,KIRR,
     1  LASTOP,FMTDAT,EDNAM,MFID,MFMOD,JMVFG,JMVOLD
C ***<<< KLSTO COMMON END >>>***
CCC        CHARACTER*1 FMTDAT(9,76)
CCC        COMMON/FMTBFR/FMTDAT
        CHARACTER*1 DVF(12),DFMT(10)
        EQUIVALENCE(DVF(2),DFMT(1))
        COMMON/DEFVBX/DVF
CCC	InTeGer*4 DLFG
CCC	COMMON/DLFG/DLFG
C DLFG IS NONZERO IF ANY D## FORMS HAVE BEEN SEEN
        InTeGer*4 MPAG(2),MPMOD
        InTeGer*2 LVALBF(5,800)
	DIMENSION MPMOD(2)
        COMMON/VB/MPAG,LVALBF,MPMOD
	InTeGer*4 MFLAST,MFBASE,MVLAST,MVBASE
	COMMON/VBCTL/MFLAST,MFBASE,MVLASE,MVBASE
CCC	InTeGer*4 MFID(2)
C        InTeGer*4 MFID,IFID(8,2048)
C        CHARACTER*1 LFID(16,2048)
C        EQUIVALENCE(IFID(1,1),LFID(1,1))
CCC        COMMON/FRM/MFID,MFMOD
C        COMMON/FRM/MFID,IFID
C
C ***<<< NULETC COMMON START >>>***
	InTeGer*4 ICREF,IRREF
C	COMMON/MIRROR/ICREF,IRREF
	InTeGer*4 MODPUB,LIMODE
C	COMMON/MODPUB/MODPUB,LIMODE
	InTeGer*4 KLKC,KLKR
	REAL*8 AACP,AACQ
C	COMMON/MSCMN/KLKC,KLKR,AACP,AACQ
	InTeGer*4 NCEL,NXINI
C	COMMON/NCEL/NCEL,NXINI
	CHARACTER*1 NAMARY(20,301)
C	COMMON/NMNMNM/NAMARY
	InTeGer*4 NULAST,LFVD
C	COMMON/NULXXX/NULAST,LFVD
	COMMON/NULETC/ICREF,IRREF,MODPUB,LIMODE,
     1  KLKC,KLKR,AACP,AACQ,NCEL,NXINI,NAMARY,NULAST,LFVD
C ***<<< NULETC COMMON END >>>***
CCC        COMMON /NCEL/NCEL,NXINI
	LINTGR=0
	MPMOD(1)=0
	MPMOD(2)=0
	MFMOD(1)=0
	MFMOD(2)=0
	DLFG=0
        IBP=1
C INITIALIZE ADDRESSES FOR FVLDSG/FVLDGT
C	CALL FVGO(FV1,LBITS)
        DO 2 N=1,9
2       FMTDAT(N,1)=DFMT(N)
        DO 3 N=2,76
        DO 3 NN=1,9
3       FMTDAT(NN,N)=CHAR(0)
        DO 1 N=1,8
	NN=128/IBP
        LBITS(N)=CHAR(NN)
1       IBP=IBP+IBP
        DO 4 N=1,2264
C CLEAR BITMAPS NOW
        FV1(N)=CHAR(0)
        FV2(N)=CHAR(0)
        FV4(N)=CHAR(0)
4       ITYP(N)=CHAR(0)
C OPEN THE WORK FILES SO WE DON'T NEED TO LATER...
C LUN 7 IS FORMULAS; LUN 9 IS VALUES
C HOWEVER, IF IPGMAX IS LESS THAN 800/205 (INDICATING ENTIRE FILE
C FITS IN MEMORY) DON'T OPEN LUN 9 AND IF LPGMXF IS < 2048/64, LIKEWISE
C FOR LUN 7.
C INITIALLY CLOSE FILES IN CASE THEY WERE OPEN...
        CLOSE(7,STATUS='DELETE')
        CLOSE(13,STATUS='DELETE')
C NOW OPEN THEM AS RANDOM ACCESS FILES.
        NBK=IPGMAX*2
C KEEP VALUE PAGES IN 500 BYTE UNITS, NOT 512 BYTE UNITS, TO COME
C OUT EVEN...
        IF(IPGMAX.GT.(800/100))OPEN(13,
     1  ACCESS='DIRECT',FORM='UNFORMATTED',
     3  RECL=500,STATUS='NEW')
        NBK=LPGMXF*2
        IF(LPGMXF.GT.(2048/64))OPEN(7,
     1  ACCESS='DIRECT',FORM='UNFORMATTED',
     3  RECL=512,STATUS='NEW')
C SET NOTHING IN MEMORY YET
        MFID(1)=0
	MFID(2)=0
        MPAG(1)=0
	MPAG(2)=0
C MARK BUFFER 1 AS IN MEMORY AND AS LAST-ACCESSED (SO WE FIRST ATTEMPT TO
C OVERWRITE BUFFER 2 TO GET STARTED.)
	MFLAST=1
	MFBASE=0
	MVLAST=1
	MVBASE=0
C ZERO MEMORY BUFFER AND FILES
C ACTUALLY MARK WITH -1 SO THAT WE CAN TELL WHEN WE HIT A VIRGIN
C AREA.
        DO 9 N=1,800
        DO 9 M=1,5
9       LVALBF(M,N)=-1
        NPG=(IPGMAX*2)
        IF(IPGMAX.LE.(800/100))GOTO 11
        DO 10 N=1,NPG
10      WRITE(13,REC=N,ERR=11)((LVALBF(K,KKK),K=1,5),KKK=1,50)
11      CONTINUE
	CALL WRKFIL(0,0,50)
C        DO 12 N=1,2048
C        DO 12 M=1,8
C12      IFID(M,N)=0
C	NPG=LPGMXF*2
C        IF(LPGMXF.LE.(2048/64))GOTO 14
C        DO 13 N=1,NPG
C13      WRITE(7,REC=N,ERR=14)((IFID(K,KKK),K=1,8),KKK=1,32)
14      CONTINUE
C SET ALL AC'S TO TYPE FLOATING...
        DO 8 N=1,27
8       IATYP(N)=2
C TYPE 2 IS REALS (DEFAULT)
        NCEL=0
	NXINI=0
        RETURN
        END
c -h- wtbini.f40	Fri Aug 22 13:43:29 1986	
C WORK FORMULA TABLE INITIALIZE FOR DTBL1 COMMON
C COPYRIGHT (C) GLENN AND MARY EVERHART 1985
C ALL RIGHTS RESERVED
	SUBROUTINE WTBINI(IFID,LPGMXF,BTBL1,BTBL2,BTBL3,BTBL4,BTBL5,
     1  BTBL6,BTBL7,BTBL8)
	CHARACTER*1 DTBL1(9,9,8)
C BIG WASTEFUL TABLE TO INIT OPERATION TYPE DATA. TRY TO REUSE SPACE.
	Integer*4 LPGMXF
C	InTeGer*2 BTBL(6,6,8)
C REUSE SPACE BY MAKING LFID AND IT OVERLAY EACH OTHER.
C NO NEED TO WASTE IT.
	InTeGer*2 IFID(8,2048)
C	CHARACTER*1 LFID(16,2048)
C	EQUIVALENCE(LFID(1,1),IFID(1,1))
C	EQUIVALENCE(IFID(1,1),BTBL(1,1,1))
	InTeGer*2 BTBL1(6,6)
	InTeGer*2 BTBL2(6,6),BTBL3(6,6),BTBL4(6,6),BTBL5(6,6)
	InTeGer*2 BTBL6(6,6),BTBL7(6,6),BTBL8(6,6)
C	EQUIVALENCE(BTBL(1,1,1),BTBL1(1,1)),(BTBL(1,1,2),BTBL2(1,1))
C	EQUIVALENCE(BTBL(1,1,3),BTBL3(1,1)),(BTBL(1,1,4),BTBL4(1,1))
C	EQUIVALENCE(BTBL(1,1,5),BTBL5(1,1)),(BTBL(1,1,6),BTBL6(1,1))
C	EQUIVALENCE(BTBL(1,1,7),BTBL7(1,1)),(BTBL(1,1,8),BTBL8(1,1))
	COMMON /DECIDE/ DTBL1
C ONLY INIT DTBL1 ENTRIES NOT CORRESPONDING TO MULTIPLE PRECISION DATA
C TYPES (WHICH ARE NOT SUPPORTED HERE)
	do 135 n3=1,8
	do 135 n2=1,9
	do 135 n1=1,9
135	dtbl1(n1,n2,n3)=CHAR(0)
	DO 35 NN2=1,6
	N2=NN2
	IF(NN2.GT.4)N2=NN2+3
	DO 235 N1=1,4
	DTBL1(N1,N2,1)=CHAR(BTBL1(N1,NN2))
	DTBL1(N1,N2,2)=CHAR(BTBL2(N1,NN2))
	DTBL1(N1,N2,3)=CHAR(BTBL3(N1,NN2))
	DTBL1(N1,N2,4)=CHAR(BTBL4(N1,NN2))
	DTBL1(N1,N2,5)=CHAR(BTBL5(N1,NN2))
	DTBL1(N1,N2,6)=CHAR(BTBL6(N1,NN2))
	DTBL1(N1,N2,7)=CHAR(BTBL7(N1,NN2))
235	DTBL1(N1,N2,8)=CHAR(BTBL8(N1,NN2))
	do 335 n1=5,6
	DTBL1(N1+3,N2,1)=CHAR(BTBL1(N1,NN2))
	DTBL1(N1+3,N2,2)=CHAR(BTBL2(N1,NN2))
	DTBL1(N1+3,N2,3)=CHAR(BTBL3(N1,NN2))
	DTBL1(N1+3,N2,4)=CHAR(BTBL4(N1,NN2))
	DTBL1(N1+3,N2,5)=CHAR(BTBL5(N1,NN2))
	DTBL1(N1+3,N2,6)=CHAR(BTBL6(N1,NN2))
	DTBL1(N1+3,N2,7)=CHAR(BTBL7(N1,NN2))
	DTBL1(N1+3,N2,8)=CHAR(BTBL8(N1,NN2))
335	continue
35	CONTINUE
C NOW CLEAR THE BUFFER OUT, HAVING SET UP DTBL1 FROM IT.
C SET INITIAL -1 SO WE CAN RECOGNIZE WHEN TO STOP LOOKING
C INITIALLY...
	DO 36 NN=1,2048
	DO 36 N=1,8
36	IFID(N,NN)=-1
C ZERO THE FILE NOW
	NPG=LPGMXF*2
        IF(LPGMXF.LE.32)GOTO 14
C        IF(LPGMXF.LE.(2048/64))GOTO 14
        DO 13 N=1,NPG
13      WRITE(7,REC=N,ERR=14)((IFID(K,KKK),K=1,8),KKK=1,32)
14      CONTINUE
	RETURN
	END
c -h- wkdy.for	Fri Aug 22 13:44:33 1986	
	SUBROUTINE WKDY(JULLO,JULHI,NDAYS)
C GIVEN START AND END JULIAN DATE, FIGURE OUT HOW MANY WEEK DAYS
C THERE ARE BETWEEN THEM.
	JL=JULLO
	JH=JULHI
	IF(JL.LE.JH)GOTO 10
	JL=JULHI
	JH=JULLO
10	CONTINUE
	IDL=(JH-JL)/7
C GET NUMBER OF WEEKS BETWEEN DAYS, 5 WORKDAYS PER WHOLE WEEK.
	IWDY=IDL*5
C ADD 3 SO THAT MODULO OF SUNDAY IS 0, NOT WED.
	IDOR=JH-JL-7*(IDL)
	IF(IDOR.NE.0)IDOR=5
C IDOR IS ORIGINAL # DAYS DIFFERENCE, CORRECTED FOR WHOLE
C WEEKS ALREADY ALLOWED.
	LD=JL+3
	LD=MOD(LD,7)
	LH=JH+3
	LH=MOD(LH,7)
C NOW HAVE DAY OF WEEK START,END. FIND WORK DAYS THAT WEEK (M-F ONLY)
	IKLU=0
	IK2=1
	IF(LD.LT.1)IK2=0
	IF(LD.LT.1)LD=1
	IF(LD.GT.5)LD=5
C FOR HIGH END OF RANGE IF THE END DATE IS SUNDAY SUBTRACT ONE DAY
C FROM THE DAYS SO WE OMIT THE MONDAY FROM THE RANGE...
	IF(LH.LT.1)IKLU=IK2
	IF(LH.LT.1)LH=1
	IF(LH.GT.5)LH=5
C LH = DAY ENDED ON, LD=START DAY, FORCED INTO WORK WEEK.
	IF (LH.GT.LD)IWDY=IWDY+LH-LD-IKLU
	IF (LH.LE.LD)IWDY=IWDY+IDOR-(LD-LH)-IKLU
C GIVES DAYS BETWEEN 2 DATES JUST LIKE JULIAN DATE SUBTRACTION FOR
C CALENDAR DATES.
	NDAYS=IWDY
	RETURN
	END
c -h- wrkint.for	Fri Aug 22 13:44:46 1986	
	SUBROUTINE WRKINT(JULLO,NWDY,JULHI)
C GETS JULLO = START DATE AND NWDY = NO. WORKDAYS (M-F) TO ADD AND
C FINDS JULHI = END JULIAN DATE, CONSTRAINED TO BE IN MONDAY TO
C FRIDAY RANGE.
C MUST ADD 3 BECAUSE THAT'S THE BIAS OF OUR JULIAN DATE BASE.
	IDJL=MOD(JULLO+3,7)
C IDJL = DAY CODE OF START DATE
	NWWK=NWDY/5
	JL=JULLO
	IF(IDJL.LT.1)JL=JL+1
	IF(IDJL.GT.5)JL=JL+2
C BUMP START INTERVAL...
	NWDD=NWDY-5*NWWK
	JL=JL+NWWK*7+NWDD
	IDJL=MOD(JL+3,7)
	IF(IDJL.LT.1)JL=JL+1
	IF(IDJL.GT.5)JL=JL+2
C FORCE OUTPUT DATE TO BE WITHIN WORKWEEK
	JULHI=JL
	RETURN
	END
